I'm trying to combine these two modules. I tried doing this, but I'm having problems flushing out what's stored in memory and so not copying new data (as specified in the second module). These are really two of the exact same modules, just each specifying different sources of data to copy - which is why I'm having the issue. I greatly appreciate any guidance on this!!
Thanks!!
Thanks!!
Code:
Sub GeoStatsState()
'EXAMINEE REQUESTED STATE
Dim i As Long
Dim lPtr1 As Long
Dim vEntries() As Variant
Dim lECount As Long
Dim lEMax As Long
Dim C As Range
Dim BFound As Boolean
lEMax = -1
lECount = -1
'Unprotect sheet first!
Worksheets("Applicant Geographic Stats").Unprotect
Application.ScreenUpdating = False
'************************************************************
'** Examine cells & store unique entries in array vEntries **
'************************************************************
For Each C In ThisWorkbook.Sheets("Complete Applicant List").Range("K2:K2500")
If VarType(C.Value) <> vbEmpty Then 'ignore empty cells
BFound = False
For i = 0 To lECount
If C.Value = vEntries(i) Then 'Test if duplicate entry
BFound = True
Exit For
End If
Next I
If BFound = False Then
lECount = lECount + 1
'** If array too small, resize it **
If lECount > lEMax Then
lEMax = lEMax + 100
ReDim Preserve vEntries(0 To lEMax)
End If
vEntries(lECount) = C.Value
End If
End If
Next C
Worksheets("Applicant Geographic Stats").Range("A2:A59").ClearContents 'clears contents of column before importing data
lPtr1 = 2 '** Set start row for output = row 2 **
With Worksheets("Applicant Geographic Stats")
For i = 0 To lECount
.Cells(lPtr1, 1).Value = vEntries(i)
lPtr1 = lPtr1 + 1
Next I
End With
Worksheets("Applicant Geographic Stats").Range("A2:A59").Sort Key1:=Worksheets("Applicant Geographic Stats").Range("A2:A59"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal 'sorts imported data ascending order
Application.ScreenUpdating = True
'Re-protect sheet.
Worksheets("Applicant Geographic Stats").Range("A:AB").Locked = True
Worksheets("Applicant Geographic Stats").Protect UserInterfaceOnly:=True
End Sub
Code:
Sub GeoStatCity()
'EXAMINEE REQUESTED CITY
Dim i As Long
Dim lPtr1 As Long
Dim vEntries() As Variant
Dim lECount As Long
Dim lEMax As Long
Dim C As Range
Dim BFound As Boolean
lEMax = -1
lECount = -1
'Unprotect sheet first!
Worksheets("Applicant Geographic Stats").Unprotect
Application.ScreenUpdating = False
'************************************************************
'** Examine cells & store unique entries in array vEntries **
'************************************************************
For Each C In ThisWorkbook.Sheets("Complete Applicant List").Range("V2:V2500")
If VarType(C.Value) <> vbEmpty Then 'ignore empty cells
BFound = False
For i = 0 To lECount
If C.Value = vEntries(i) Then 'Test if duplicate entry
BFound = True
Exit For
End If
Next i
If BFound = False Then
lECount = lECount + 1
'** If array too small, resize it **
If lECount > lEMax Then
lEMax = lEMax + 100
ReDim Preserve vEntries(0 To lEMax)
End If
vEntries(lECount) = C.Value
End If
End If
Next C
Worksheets("Applicant Geographic Stats").Range("E2:E59").ClearContents 'clears contents of column before importing data
lPtr1 = 2 '** Set start row for output = row 2 **
With Worksheets("Applicant Geographic Stats")
For i = 0 To lECount
.Cells(lPtr1, 5).Value = vEntries(i)
lPtr1 = lPtr1 + 1
Next i
End With
Worksheets("Applicant Geographic Stats").Range("E2:E59").Sort Key1:=Worksheets("Applicant Geographic Stats").Range("E2:E59"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal 'sorts imported data ascending order
Application.ScreenUpdating = True
'Re-protect sheet.
Worksheets("Applicant Geographic Stats").Range("A:AB").Locked = True
Worksheets("Applicant Geographic Stats").Protect UserInterfaceOnly:=True
End Sub
Last edited: