Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
conn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Data Source=.;Initial Catalog=CourseMasterDB;"
conn.Open
querystring = "Select GeoName from MST_Geo"
i = 0
k = 3
rst.Open querystring, conn, adOpenStatic
ReDim geoArray(rst.RecordCount)
Do While Not rst.EOF
geoArray(i) = rst.Fields(0).Value
rst.MoveNext
i = i + 1
Loop
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
For k = 3 To ThisWorkbook.Sheets.Count
Set lookuprng = ThisWorkbook.Sheets(k).Columns("J:J").Find("Select GEO", LookIn:=xlValues, lookat:=xlWhole)
If (Not lookuprng Is Nothing) Then
ThisWorkbook.Sheets(k).Range(lookuprng.Address).ClearContents
ThisWorkbook.Sheets(k).Range(lookuprng.Offset(0, 1).Address).Validation.Delete
End If
rowcount = ThisWorkbook.Sheets(k).Range("J" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)) = "Select GEO"
ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)).FontSize = 15
ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)).Interior.ColorIndex = 24
With ThisWorkbook.Sheets(k).Range("K" & (rowcount + 15)).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(geoArray, ",")
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Set rst = New ADODB.Recordset
conn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Data Source=.;Initial Catalog=CourseMasterDB;"
conn.Open
querystring = "Select GeoName from MST_Geo"
i = 0
k = 3
rst.Open querystring, conn, adOpenStatic
ReDim geoArray(rst.RecordCount)
Do While Not rst.EOF
geoArray(i) = rst.Fields(0).Value
rst.MoveNext
i = i + 1
Loop
rst.Close
conn.Close
Set rst = Nothing
Set conn = Nothing
For k = 3 To ThisWorkbook.Sheets.Count
Set lookuprng = ThisWorkbook.Sheets(k).Columns("J:J").Find("Select GEO", LookIn:=xlValues, lookat:=xlWhole)
If (Not lookuprng Is Nothing) Then
ThisWorkbook.Sheets(k).Range(lookuprng.Address).ClearContents
ThisWorkbook.Sheets(k).Range(lookuprng.Offset(0, 1).Address).Validation.Delete
End If
rowcount = ThisWorkbook.Sheets(k).Range("J" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)) = "Select GEO"
ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)).FontSize = 15
ThisWorkbook.Sheets(k).Range("J" & (rowcount + 15)).Interior.ColorIndex = 24
With ThisWorkbook.Sheets(k).Range("K" & (rowcount + 15)).Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(geoArray, ",")
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
No comments:
Post a Comment