Hello friends.
Here is the background of the project.
Steps I have to take.
1) I have to run a report generated from our accounting software daily. It is a CVS file but that should not be a big deal.
2)I have a master sheet that I want to import all of the information from the CVS file but need to filter the data on the first inport to not have any projects that have an Invoice #.
3)Once I rerun the report I need to import the new projects and update any old projects to the master sheet.
I think I have most of the code written (See Below) but when I run the VBA to update the master sheet it does not update the sheet correctly.
I'm open to any changes also.
Any help would be great.
Send me a Private message and I can send you the files. It won't let me attach them since I'm new.
Thanks,
Chris
Private Type GUID_TYPE
'// Vars
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
'// Test for 32 or 64 bit Excel
#If VBA7 Then
Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr
#Else
Private Declare Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As Long
Private Declare Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As Long
#End If
Function CreateGuidString(Optional AddHyphens As Boolean, _
Optional AddBraces As Boolean) _
As String
'// Vars
Dim guid As GUID_TYPE
Dim strGuid As String
Dim retValue As LongPtr
Const guidLength As Long = 39
retValue = CoCreateGuid(guid)
'// Get the raw GUID which includes braces and hyphens
If retValue = 0 Then
strGuid = String$(guidLength, vbNullChar)
retValue = StringFromGUID2(guid, StrPtr(strGuid), guidLength)
If retValue = guidLength Then
CreateGuidString = strGuid
End If
End If
'// If AddHyphens is switched from the default True to False,
' remove them from the GUID
If Not AddHyphens Then
CreateGuidString = Replace(CreateGuidString, "-", vbNullString, Compare:=vbTextCompare)
End If
'// If AddBraces is True from the default False to True,
' leave those curly braces be!
If Not AddBraces Then
CreateGuidString = Replace(CreateGuidString, "{", vbNullString, Compare:=vbTextCompare)
CreateGuidString = Replace(CreateGuidString, "}", vbNullString, Compare:=vbTextCompare)
End If
End Function
Private Sub Import_NewReport_NotInvoiced() ' This Macro imports all information from the new report that does not have an invoice number.
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wRng As Range, wb1Rng As Range
Dim strQuote As String, strPart As String, strQty As String
Set wb1 = ThisWorkbook
Set wb2 = Application.Workbooks.Open("C:\Users\cbrannam\Downloads\Quotation Summary - Detail Report.csv")
Set ws1 = wb1.Worksheets("Master")
Set ws2 = wb2.Worksheets("Quotation Summary - Detail Repo")
ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
ws2.AutoFilterMode = False
ws2.Sort.SortFields. _
Clear
ws2.Sort.SortFields. _
Add2 Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ws2.Sort
.SetRange Range("A1:AP" & ws2LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
i = 0
Set ws2Filt = ws2.Range("AO1:AO" & ws2LastRow)
With ws2Filt
.AutoFilter Field:=1, Criteria1:=""
LastRVis2 = .Offset(, -40).End(xlDown).Row
End With
Set ws2Rng = ws2.Range("A1:A" & LastRVis2)
Set ws1Rng = ws1.Range("A1:A" & ws1LastRow)
With ws2Rng.SpecialCells(xlCellTypeVisible)
For Each ws2Cell In ws2Rng.SpecialCells(xlCellTypeVisible)
ws2r = ws2Cell.Row
strQuote = Cells(ws2r, "A").Address(rowabsolute:=False, columnabsolute:=False)
strPart = Cells(ws2r, "C").Address(rowabsolute:=False, columnabsolute:=False)
strQty = Cells(ws2r, "E").Address(rowabsolute:=False, columnabsolute:=False)
ufProgress.LabelProgress.Width = 0
ufProgress.Show
pctdone = ws2r / ws2LastRow
With ufProgress
.LabelCaption.Caption = "Processing Row " & ws2r & " of " & LastRVis2
.LabelProgress.Width = pctdone * (.FrameProgress.Width)
End With
DoEvents
With ws1Rng
'Set ws1Srch = .Find(What:=ws2.Cells(ws2r, "A").Value, LookIn:=xlValues)
r = Evaluate("=MATCH(" & strQuote & "&" & strPart & "&" & strQty & ",'[Master Tracker.xlsm]Master'!$A:$A&'[Master Tracker.xlsm]Master'!$C:$C&'[Master Tracker.xlsm]Master'!$E:$E,)")
Set ws1srch = .Cells(r, "A")
If Not ws1srch Is Nothing Then
Adrs1 = ws1srch.Address
Do
ws1.Cells(ws1srch.Row, "A").Value = ws2.Cells(ws2r, "A").Value
ws1.Cells(ws1srch.Row, "C").Resize(, 4).Value = ws2.Cells(ws2r, "C").Resize(, 4).Value
ws1.Cells(ws1srch.Row, "I").Resize(, 3).Value = ws2.Cells(ws2r, "I").Resize(, 3).Value
ws1.Cells(ws1srch.Row, "R").Value = ws2.Cells(ws2r, "R").Value
ws1.Cells(ws1srch.Row, "T").Resize(, 6).Value = ws2.Cells(ws2r, "T").Resize(, 6).Value
ws1.Cells(ws1srch.Row, "AC").Value = ws2.Cells(ws2r, "AC").Value
ws1.Cells(ws1srch.Row, "AN").Resize(, 3).Value = ws2.Cells(ws2r, "AN").Resize(, 3).Value
Set ws1srch = .FindNext(ws1srch)
ws1R = ws1R + 1
' Add a counter to increment through the new report rather than overwriting every instance of quote# on the master with the first
If ws1srch Is Nothing Then
' Create new unmatched row at the bottom of the master.
End If
Loop While ws1srch.Address <> Adrs1
Else
If i = 0 Then
i = 1
Else
End If
ws1.Cells(ws1LastRow + i, "A").EntireRow.Value = ws2.Cells(ws2r, "A").EntireRow.Value
ws1.Cells(ws1LastRow + i, "BB").Value = CreateGuidString
i = i + 1
End If
End With
If ws1R = LastRVis2 Then Unload ufProgress
Next ws2Cell
With ws1.Sort
.SetRange Range("A1:AP" & ws1LastRow + i)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
If i = 0 Then
MsgBox "No New Rows to Add"
ElseIf i = 1 Then
MsgBox "Added " & i & " row to the Master."
Else
MsgBox "Added " & i & " rows to the Master."
End If
End With
ws2.AutoFilterMode = False
wb2.Close SaveChanges:=False
End Sub
Here is the background of the project.
Steps I have to take.
1) I have to run a report generated from our accounting software daily. It is a CVS file but that should not be a big deal.
2)I have a master sheet that I want to import all of the information from the CVS file but need to filter the data on the first inport to not have any projects that have an Invoice #.
3)Once I rerun the report I need to import the new projects and update any old projects to the master sheet.
I think I have most of the code written (See Below) but when I run the VBA to update the master sheet it does not update the sheet correctly.
I'm open to any changes also.
Any help would be great.
Send me a Private message and I can send you the files. It won't let me attach them since I'm new.
Thanks,
Chris
Private Type GUID_TYPE
'// Vars
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
'// Test for 32 or 64 bit Excel
#If VBA7 Then
Private Declare PtrSafe Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As LongPtr
Private Declare PtrSafe Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As LongPtr
#Else
Private Declare Function CoCreateGuid Lib "ole32.dll" (guid As GUID_TYPE) As Long
Private Declare Function StringFromGUID2 Lib "ole32.dll" (guid As GUID_TYPE, ByVal lpStrGuid As LongPtr, ByVal cbMax As Long) As Long
#End If
Function CreateGuidString(Optional AddHyphens As Boolean, _
Optional AddBraces As Boolean) _
As String
'// Vars
Dim guid As GUID_TYPE
Dim strGuid As String
Dim retValue As LongPtr
Const guidLength As Long = 39
retValue = CoCreateGuid(guid)
'// Get the raw GUID which includes braces and hyphens
If retValue = 0 Then
strGuid = String$(guidLength, vbNullChar)
retValue = StringFromGUID2(guid, StrPtr(strGuid), guidLength)
If retValue = guidLength Then
CreateGuidString = strGuid
End If
End If
'// If AddHyphens is switched from the default True to False,
' remove them from the GUID
If Not AddHyphens Then
CreateGuidString = Replace(CreateGuidString, "-", vbNullString, Compare:=vbTextCompare)
End If
'// If AddBraces is True from the default False to True,
' leave those curly braces be!
If Not AddBraces Then
CreateGuidString = Replace(CreateGuidString, "{", vbNullString, Compare:=vbTextCompare)
CreateGuidString = Replace(CreateGuidString, "}", vbNullString, Compare:=vbTextCompare)
End If
End Function
Private Sub Import_NewReport_NotInvoiced() ' This Macro imports all information from the new report that does not have an invoice number.
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim wRng As Range, wb1Rng As Range
Dim strQuote As String, strPart As String, strQty As String
Set wb1 = ThisWorkbook
Set wb2 = Application.Workbooks.Open("C:\Users\cbrannam\Downloads\Quotation Summary - Detail Report.csv")
Set ws1 = wb1.Worksheets("Master")
Set ws2 = wb2.Worksheets("Quotation Summary - Detail Repo")
ws1LastRow = ws1.Cells(Rows.Count, "A").End(xlUp).Row
ws2LastRow = ws2.Cells(Rows.Count, "A").End(xlUp).Row
ws2.AutoFilterMode = False
ws2.Sort.SortFields. _
Clear
ws2.Sort.SortFields. _
Add2 Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ws2.Sort
.SetRange Range("A1:AP" & ws2LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
i = 0
Set ws2Filt = ws2.Range("AO1:AO" & ws2LastRow)
With ws2Filt
.AutoFilter Field:=1, Criteria1:=""
LastRVis2 = .Offset(, -40).End(xlDown).Row
End With
Set ws2Rng = ws2.Range("A1:A" & LastRVis2)
Set ws1Rng = ws1.Range("A1:A" & ws1LastRow)
With ws2Rng.SpecialCells(xlCellTypeVisible)
For Each ws2Cell In ws2Rng.SpecialCells(xlCellTypeVisible)
ws2r = ws2Cell.Row
strQuote = Cells(ws2r, "A").Address(rowabsolute:=False, columnabsolute:=False)
strPart = Cells(ws2r, "C").Address(rowabsolute:=False, columnabsolute:=False)
strQty = Cells(ws2r, "E").Address(rowabsolute:=False, columnabsolute:=False)
ufProgress.LabelProgress.Width = 0
ufProgress.Show
pctdone = ws2r / ws2LastRow
With ufProgress
.LabelCaption.Caption = "Processing Row " & ws2r & " of " & LastRVis2
.LabelProgress.Width = pctdone * (.FrameProgress.Width)
End With
DoEvents
With ws1Rng
'Set ws1Srch = .Find(What:=ws2.Cells(ws2r, "A").Value, LookIn:=xlValues)
r = Evaluate("=MATCH(" & strQuote & "&" & strPart & "&" & strQty & ",'[Master Tracker.xlsm]Master'!$A:$A&'[Master Tracker.xlsm]Master'!$C:$C&'[Master Tracker.xlsm]Master'!$E:$E,)")
Set ws1srch = .Cells(r, "A")
If Not ws1srch Is Nothing Then
Adrs1 = ws1srch.Address
Do
ws1.Cells(ws1srch.Row, "A").Value = ws2.Cells(ws2r, "A").Value
ws1.Cells(ws1srch.Row, "C").Resize(, 4).Value = ws2.Cells(ws2r, "C").Resize(, 4).Value
ws1.Cells(ws1srch.Row, "I").Resize(, 3).Value = ws2.Cells(ws2r, "I").Resize(, 3).Value
ws1.Cells(ws1srch.Row, "R").Value = ws2.Cells(ws2r, "R").Value
ws1.Cells(ws1srch.Row, "T").Resize(, 6).Value = ws2.Cells(ws2r, "T").Resize(, 6).Value
ws1.Cells(ws1srch.Row, "AC").Value = ws2.Cells(ws2r, "AC").Value
ws1.Cells(ws1srch.Row, "AN").Resize(, 3).Value = ws2.Cells(ws2r, "AN").Resize(, 3).Value
Set ws1srch = .FindNext(ws1srch)
ws1R = ws1R + 1
' Add a counter to increment through the new report rather than overwriting every instance of quote# on the master with the first
If ws1srch Is Nothing Then
' Create new unmatched row at the bottom of the master.
End If
Loop While ws1srch.Address <> Adrs1
Else
If i = 0 Then
i = 1
Else
End If
ws1.Cells(ws1LastRow + i, "A").EntireRow.Value = ws2.Cells(ws2r, "A").EntireRow.Value
ws1.Cells(ws1LastRow + i, "BB").Value = CreateGuidString
i = i + 1
End If
End With
If ws1R = LastRVis2 Then Unload ufProgress
Next ws2Cell
With ws1.Sort
.SetRange Range("A1:AP" & ws1LastRow + i)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
If i = 0 Then
MsgBox "No New Rows to Add"
ElseIf i = 1 Then
MsgBox "Added " & i & " row to the Master."
Else
MsgBox "Added " & i & " rows to the Master."
End If
End With
ws2.AutoFilterMode = False
wb2.Close SaveChanges:=False
End Sub
