CountIf Macro - Help Needed - Attempt At Code Supplied

[excelnube]

Hi guys,

I have a query about a section in a macro im trying to create.

I have two workbooks:

1) DataDump.xls
2) CurrentRecords.xls

The DataDumb file is populated automatically every at every 32mins past the hour via a seperate DB. A macro within the CurrentRecords.xls copies some of the records within the DataDump.xls every 35mins - in the attempt to capture the most up-to-date info.

What i am trying to do is that, before CurrentRecords.xls copies the records within DataDump.xls, i would like it to check to see if a value in Column A (ID number) within the CurrentRecords exists within Column A (ID number) in the DataDump. If yes, carry on the macro as usual. If no, copy that entire row from CurrentRecords to sheet2 in the CurrentRecords.xls.

Here is what i have so far:

Public dTime As Date
Sub Collect_RawData()
''  Update the data every 20 seconds
    dTime = Now + TimeValue("00:35:00")
    Application.OnTime dTime, "Collect_RawData"
''  Local Variables \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    Dim wkbData     As Workbook
    Dim cell        As Range
    Dim c1, c2, r1, r2 As Integer
''  Retreive all available data in source workbook \\\\\\\\\\\\\\\\\\\\\\\\\
''  Open DawData \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    Set wkbData = Workbooks.Open(Filename:="C:\Documents and Settings\lewisH\Desktop\DataDump.xls", ReadOnly:=False)
     
''  Check if A1 in RawData is not blank \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    If wkbData.Worksheets("Sheet1").Range("A1") = "" Then
       wkbData.Close False
    Else
        r1 = 1
''      Start on second row to stop writing in headings \\\\\\\\\\\\\\\\\\\\
        r2 = 2
        Do Until r1 = Application.WorksheetFunction.CountA(wkbData.Worksheets("Sheet1").Columns(1)) + 1
''      If the values in RawData Coloumn 1 aren't blank, then \\\\\\\\\\\\\\
        If wkbData.Worksheets("Sheet1").Cells(r1, 1).Value <> "" Then
           
''          Copy row from RawData sheet to Comms sheet \\\\\\\\\\\\\\\\\\\\\\\\\
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 1).Value = wkbData.Worksheets("Sheet1").Cells(r1, 1).Value
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 2).Value = wkbData.Worksheets("Sheet1").Cells(r1, 2).Value
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 3).Value = wkbData.Worksheets("Sheet1").Cells(r1, 3).Value
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 4).Value = wkbData.Worksheets("Sheet1").Cells(r1, 4).Value
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 5).Value = wkbData.Worksheets("Sheet1").Cells(r1, 5).Value
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 6).Value = wkbData.Worksheets("Sheet1").Cells(r1, 6).Value
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 7).Formula = "=IF((F" & r2 & ")="""", """", NETWORKDAYS((F" & r2 & "),NOW())-1)"
            ThisWorkbook.Sheets("Sheet1").Cells(r2, 8).Formula = "=$F" & r2 & "+(INDEX(CommsFrequency!$B$3:$D$7,MATCH(Sheet1!$B" & r2 & ",CommsFrequency!$B:$B,0)-2,3)*0.000694444444444444)"
''          Populate next row
            r2 = r2 + 1
           
        End If
' ////////////////////////////////////////////////////////////////////////
'       To see if ID number within CurrentRecords exists within DataDump
'       If Application.WorksheetFunction.CountIf(ThisWorkbook.Sheets("Sheet1").Column(1), wkbData.Sheets("Sheet1").cell(r1, 1).Value) > 0 Then
            
'       Move entire missing row from CurrentRecords Sheet1 to CurrentRecords Sheet2
            
'       End If
' ////////////////////////////////////////////////////////////////////////
        r1 = r1 + 1
           Loop
            wkbData.Close False
    End If
''  Loop
     
''  Save and close the Comms file \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    ActiveWorkbook.Saved = True
'   ActiveWorkbook.Close SaveChanges:=True
End Sub

 

[AlphaFrog]

Sub Collect_RawData2()
''  Update the data every 20 seconds
    dTime = Now + TimeValue("00:35:00")
    Application.OnTime dTime, "Collect_RawData"
''  Local Variables \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    Dim wbData      As Workbook
    Dim wsData      As Worksheet
    Dim ws1         As Worksheet
    Dim ws2         As Worksheet
    Dim Lastrow     As Long
    Dim cell        As Range
    
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
''  Retreive all available data in source workbook \\\\\\\\\\\\\\\\\\\\\\\\\
''  Open DawData \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    Set wbData = Workbooks.Open(Filename:="C:\Documents and Settings\lewisH\Desktop\DataDump.xls", ReadOnly:=False)
    Set wsData = wbData.Worksheets("Sheet1")
    
''  Check if A1 in RawData is not blank \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    If wsData.Range("A1") <> "" Then
        'check to see if a value in Column A (ID number) within the CurrentRecords exists within Column A (ID number) in the DataDump
        'Log old IDs to Sheet2 that don't exist in new wsData
        For Each cell In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
            ' Test if ID is found in column A on wsData
            If wsData.Range("A:A").Find(cell.Value, , xlValues, xlWhole, , , False) Is Nothing Then
                'ID not found on wsData so copy it to Sheet2
                Lastrow = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1 'Next empty row on Sheet2
                ws2.Range("A" & Lastrow).Resize(, 8).Value = cell.Resize(, 8).Value
            End If
        Next cell
    
        ' Clear previous Sheet1 data ???
        'ws1.Range("A2:H" & ws1.Range("A" & Rows.Count).End(xlUp).Row).ClearContents
    
        'Copy data
        Lastrow = wsData.Range("A" & Rows.Count).End(xlUp).Row                  'Last used row in column A on wsData
        wsData.Range("A1:A" & Lastrow).AutoFilter Field:=1, Criteria1:="<>"     'Filter on all non Blanks
        wsData.Range("A1:F" & Lastrow).SpecialCells(xlCellTypeVisible).Copy _
            Destination:=ws1.Range("A2")                                        'Copy all visible filtered rows to ws1
        wsData.AutoFilterMode = False                                           'Turn off Autofilter
        ' Formulas
        Lastrow = ws1.Range("A" & Rows.Count).End(xlUp).Row                     'Last used row in column A on ws1
        ws1.Range("G2:G" & Lastrow).FormulaR1C1 = "=IF((RC[-1])="""", """", NETWORKDAYS((RC[-1]),NOW())-1)"
        ws1.Range("H2:H" & Lastrow).FormulaR1C1 = "=RC6+(INDEX(CommsFrequency!R3C2:R7C4,MATCH(Sheet1!RC2,CommsFrequency!C2,0)-2,3)*0.000694444444444444)"
    
    End If
    
    wbData.Close False
''  Save and close the Comms file \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
    ActiveWorkbook.Saved = True
'   ActiveWorkbook.Close SaveChanges:=True

End Sub