Re: VBA, pulling values together to do a comparison
That suggests it's not finding the value. When it errors, debug and hover over the coloured line and see what the value or 'r' is. I thought you said the tables were identical? If not, perhaps it's not the 4th column.
Re: VBA, pulling values together to do a comparison
Quote from StephenR;774460That suggests it's not finding the value. When it errors, debug and hover over the coloured line and see what the value or 'r' is. I thought you said the tables were identical? If not, perhaps it's not the 4th column.
Ah I see , that value that r equals does not exist in one of the workbooks, is there a way of identifying these as N/A's in the master sheet?
Re: VBA, pulling values together to do a comparison
Adjust what you want to show as N/A. (By the way, no need to quote posts in your replied.)
Sub x()
Dim wb1 As Workbook, wb2 As Workbook, ws As Worksheet, rWB1 As Range, rWB2 As Range, r As Range, n
' Turn off screen updating and automatic calculation
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
Set wb1 = Workbooks.Open(.SelectedItems(1))
Set wb2 = Workbooks.Open(.SelectedItems(2))
End With
For Each ws In wb1.Worksheets
ws.Range("1:1").Delete
For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Cells(i, "D").Value = ws.Cells(i, "C").Value & "_" & ws.Cells(i, "B").Value
Next i
Next ws
For Each ws In wb2.Worksheets
ws.Range("1:1").Delete
For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Cells(i, "D").Value = ws.Cells(i, "C").Value & "_" & ws.Cells(i, "B").Value
Next i
Next ws
Set rWB1 = wb1.Sheets(1).Range("A2").CurrentRegion ' may have to change sheet
Set rWB2 = wb2.Sheets(1).Range("A2").CurrentRegion ' may have to change sheet
With ThisWorkbook.Sheets(1) ' may have to change workbook/sheet
.Range("A1:D1").Value = Array("Concatenated (Country and City)", _
"Number from workbook 1", _
"Number from workbook 2", _
"Difference")
For Each r In rWB1.Columns(4).Offset(1).Resize(rWB1.Rows.Count - 1).Cells
n = Application.Match(r, rWB2.Columns(4), 0)
if isnumeric(n) then
.Range("A" & Rows.Count).End(xlUp)(2).Value = r.Value
.Range("B" & Rows.Count).End(xlUp)(2).Value = r.Offset(, -3).Value
.Range("C" & Rows.Count).End(xlUp)(2).Value = rWB2.Cells(n, 1).Value
.Range("D" & Rows.Count).End(xlUp)(2).Value = r.Offset(, -3).Value - rWB2.Cells(n, 1).Value
else
.Range("A" & Rows.Count).End(xlUp)(2).Value = "N/A"
end if
Next r
End With
' Reset system settings
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
.Visible = True
End With
End SubRe: VBA, pulling values together to do a comparison
I can only go on the information you provide and I do not intend to spend my time trying to figure out what your files may or may not look like. Post a representative file if you want further help.
Re: VBA, pulling values together to do a comparison
Does this more help address the Missing records?
Re: VBA, pulling values together to do a comparison
Right, try this. The delimiting bit got lost in the last couple of amendments.
Sub x()
Dim wb1 As Workbook, wb2 As Workbook, ws As Worksheet, rWB1 As Range, rWB2 As Range, r As Range, n
' Turn off screen updating and automatic calculation
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
Workbooks.OpenText Filename:=.SelectedItems(1), DataType:=xlDelimited, Other:=True, OtherChar:="|"
Set wb1 = ActiveWorkbook
Workbooks.OpenText Filename:=.SelectedItems(2), DataType:=xlDelimited, Other:=True, OtherChar:="|"
Set wb2 = ActiveWorkbook
End With
For Each ws In wb1.Worksheets
ws.Range("1:1").Delete
For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Cells(i, "D").Value = ws.Cells(i, "C").Value & "_" & ws.Cells(i, "B").Value
Next i
Next ws
For Each ws In wb2.Worksheets
ws.Range("1:1").Delete
For i = 2 To ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Cells(i, "D").Value = ws.Cells(i, "C").Value & "_" & ws.Cells(i, "B").Value
Next i
Next ws
Set rWB1 = wb1.Sheets(1).Range("A2").CurrentRegion ' may have to change sheet
Set rWB2 = wb2.Sheets(1).Range("A2").CurrentRegion ' may have to change sheet
With ThisWorkbook.Sheets(1) ' may have to change workbook/sheet
.Range("A1:D1").Value = Array("Concatenated (Country and City)", _
"Number from workbook 1", _
"Number from workbook 2", _
"Difference")
For Each r In rWB1.Columns(4).Offset(1).Resize(rWB1.Rows.Count - 1).Cells
n = Application.Match(r, rWB2.Columns(4), 0)
.Range("A" & Rows.Count).End(xlUp)(2).Value = r.Value
.Range("B" & Rows.Count).End(xlUp)(2).Value = r.Offset(, -3).Value
If IsNumeric(n) Then
.Range("C" & Rows.Count).End(xlUp)(2).Value = rWB2.Cells(n, 1).Value
.Range("D" & Rows.Count).End(xlUp)(2).Value = r.Offset(, -3).Value - rWB2.Cells(n, 1).Value
Else
.Range("C" & Rows.Count).End(xlUp)(2).Value = "N/A"
.Range("D" & Rows.Count).End(xlUp)(2).Value = "N/A"
End If
Next r
End With
' Reset system settings
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = True
.Visible = True
End With
End SubRe: VBA, pulling values together to do a comparison
Hi Steven, thanks it works great!!
Is there ways to skip errors such as not clicking any files in the picker ? This is just bonus really, you solved the answer.
Re: VBA, pulling values together to do a comparison
You could add a line in this section so that if fewer than two files are picked the sub ends
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
If .SelectedItems.Count < 2 Then Exit Sub
Workbooks.OpenText Filename:=.SelectedItems(1), DataType:=xlDelimited, Other:=True, OtherChar:="|"
Set wb1 = ActiveWorkbook
Workbooks.OpenText Filename:=.SelectedItems(2), DataType:=xlDelimited, Other:=True, OtherChar:="|"
Set wb2 = ActiveWorkbook
End WithRe: VBA, pulling values together to do a comparison
Nice! works awesome! So before would it work with multiple files?
Also what if I want to close workbooks without saving after the reconciliation is complete?
Don’t have an account yet? Register yourself now and be a part of our community!