Hello again, my adventure in automation with VBA has lead me to a new-to-me issue
What the macro is supposed to do:
1) prompt user for a source data file
2) open source data file, and sort the data by four criteria columns
3) copy data from three of the columns to the destination sheet
4) sort the copied data by two criteria columns and remove rows that are duplicates in both columns
5) copy data from the source, creating dual-column entries in the destination sheet for each unique item in source column 1
6) close source data without saving
Where things are going wrong and what it is telling me:
when applying the first sorting on the source data, it is giving a 1004 error stating that the sort reference is not valid
What I have done so far to try to resolve this:
All the search results I have seen for this error either use the older sort method or boiled down to the user not specifying their target workbook in their key definitions. Neither seems applicable to this case because I am using the newer sort method and my keys all use a sheet object that points at the correct workbook.
My scripting attempt:
Can anyone spot what I am not seeing that I am doing wrong here?
What the macro is supposed to do:
1) prompt user for a source data file
2) open source data file, and sort the data by four criteria columns
3) copy data from three of the columns to the destination sheet
4) sort the copied data by two criteria columns and remove rows that are duplicates in both columns
5) copy data from the source, creating dual-column entries in the destination sheet for each unique item in source column 1
6) close source data without saving
Where things are going wrong and what it is telling me:
when applying the first sorting on the source data, it is giving a 1004 error stating that the sort reference is not valid
What I have done so far to try to resolve this:
All the search results I have seen for this error either use the older sort method or boiled down to the user not specifying their target workbook in their key definitions. Neither seems applicable to this case because I am using the newer sort method and my keys all use a sheet object that points at the correct workbook.
My scripting attempt:
VBA Code:
Option Explicit
Dim swb As Workbook
Dim sws As Worksheet
Dim dwb As Workbook
Dim dws As Worksheet
Sub slctsrc()
Dim fd As Office.FileDialog
Dim flnm As String
'open file picker
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.Filters.Clear
.Filters.Add "Excel Files", "*.xls?", 1
.Title = "Select the source file"
.AllowMultiSelect = False
'user's documents folder
.InitialFileName = Environ("USERPROFILE") & "\Documents\"
If .Show = True Then flnm = .SelectedItems(1)
End With
'select source data file
If flnm <> "False" Then
Set swb = Workbooks.Open(flnm)
Set sws = swb.Sheets(1)
End If
trnsfr
End Sub
Sub trnsfr()
Dim srng As Range, drng As Range, srt As Range, pos As Range
Set dwb = ThisWorkbook
Set dws = dwb.Sheets("Data")
Set srng = sws.Range("A2")
Set pos = sws.Cells(srng.End(xlDown).Row, srng.End(xlToRight).Column)
Set srt = sws.Range(srng.Address & ":" & pos.Address)
'sort source data by person, course, revision
With sws.Sort
.SortFields.Clear
.SortFields.Add Key:=sws.Range("B2:B" & pos.Row)
.SortFields.Add Key:=sws.Range("C2:C" & pos.Row)
.SortFields.Add Key:=sws.Range("E2:E" & pos.Row)
.SortFields.Add Key:=sws.Range("I2:I" & pos.Row)
.SetRange srt
.Header = xlNo
.MatchCase = False
.Apply
End With
'clear out data sheet and set up first three columns
dws.Cells.Clear
Set drng = dws.Range("A2")
drng.Value = "Course"
drng.Offset(0, 1).Value = "SOP"
drng.Offset(0, 2).Value = "Version"
'add data
Do While srng <> vbNullString
drng.Value = srng.Offset(0, 4).Value
drng.Offset(0, 1).Value = srng.Offset(0, 7).Value
drng.Offset(0, 2).Value = srng.Offset(0, 8).Value
Set srng = srng.Offset(1, 0)
Set drng = drng.Offset(1, 0)
Loop
'sort added data by course, revision
Set pos = dws.Range("C" & dws.Range("A3").End(xlDown).Row)
Set srt = dwb.Range("A3:C" & pos.Row)
With dws.Sort
.SortFields.Clear
.SortFields.Add Key:=dws.Range("A3:A" & pos.Row)
.SortFields.Add Key:=dws.Range("C3:C" & pos.Row)
.SetRange srt
.Header = xlNo
.MatchCase = False
.Apply
End With
rmvdp
End Sub
Sub rmvdp()
Dim rng As Range, chk As Range
Set rng = dws.Range("A3")
Set chk = rng.Offset(-1, 0)
Do While rng.Value <> vbNullString
'check if course and version are the same as previous
If rng.Value = chk.Value _
And rng.Offset(0, 1).Value = chk.Offset(0, 1).Value _
And rng.Offset(0, 2).Value = chk.Offset(0, 2).Value Then
dws.Rows(rng.Row).Delete
Set rng = chk.Offset(1, 0)
Else
Set rng = rng.Offset(1, 0)
Set chk = chk.Offset(1, 0)
End If
Loop
pplt
End Sub
Sub pplt()
Dim srng As Range, drng As Range, cll As Range
Dim ref As String
Dim ndr As Double
Set srng = sws.Range("A2")
Set drng = dws.Range("D1")
ndr = dws.Range("A2").End(xlDown).Row
Do While srng <> vbNullString
If drng.Row = 1 Then
With drng
.Value = srng.Value
.Offset(1, 0).Value = "R&U"
.Offset(1, 1).Value "Qual"
.Resize(1, 2).MergeCells
ref = .Text
End With
Set drng = dws.Range(drng.Offset(2, 0).Address & ":" & drng.Column & ndr)
End If
For Each cll In drng
If dws.Cells(cll.Row, 1).Value = srng.Offset(0, 4).Value _
And dws.Cells(cll.Row, 3).Value = srng.Offset(0, 8).Value Then
If srng.Offset(0, 5).Value = "R&U" Then
cll.Value = srng.Offset(0, 9).Value
Else
cll.Offset(0, 1).Value = srng.Offset(0, 9).Value
End If
Exit For
End If
Next cll
Set srng = srng.offet(1, 0)
If srng.Text <> ref Then
Set drng = dws.Cells(1, drng.Column + 2)
End If
Loop
End Sub
Can anyone spot what I am not seeing that I am doing wrong here?