Hey everyone,
I am putting together multiple worksheets with dumped data that should sort themselves by the press of a button. Each entry has a 'code' and a value and they are sorted by the 'code'.
At the moment i have the first worksheet sorting correctly and i am trying to program the second worksheet to sort data into the existing worksheets if they exist or create a new worksheet if the data doesn't have it's own worksheet.
Here is the code i am working with.
Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer, rCount As Integer
Dim firstr As Integer, lastr As Integer
Dim rangeStr As String
Dim flag() As Boolean
Dim First As Integer, last As Integer
Dim c As Integer, d As Integer, sCount As Integer
Dim sflag() As Boolean
Dim sheetrangeStr As String
Dim sFirst As Integer, slast As Integer
Application.DisplayAlerts = False
For i = ThisWorkbook.Sheets.Count To 3 Step -1
ThisWorkbook.Sheets(i).Delete
Next i
With ThisWorkbook
rCount = Sheets(2).Cells(Sheets(1).Rows.Count, 9).End(xlUp).Row
ReDim flag(rCount + 1)
i = 3
For i = 3 To rCount
rangeStr = "1:1"
If flag(i) = False Then
flag(i) = True
rangeStr = rangeStr & "," & i & ":" & i
For j = i + 1 To rCount
First = j
If (flag(j) = False) And (Cells(i, 9) = Cells(j, 9)) Then
flag(j) = True
last = j
While last <= rCount And Cells(i, 9) = Cells(last, 9)
flag(last) = True
last = last + 1
Wend
rangeStr = rangeStr & "," & First & ":" & last - 1
j = last - 1
End If
Next j
sCount = .Sheets.Count
ReDim sflag(sCount + 1)
For c = 2 To sCount
sheetrangeStr = "1:1"
If sflag(c) = False Then
sflag(c) = True
sheetrangeStr = sheetrangeStr & "," & c & ":" & c
For d = c + 1 To sCount
sFirst = d
If (sflag(d) = False) And (.Sheets(c) = .Sheets(d)) Then
sflag(d) = True
slast = d
While last <= sCount And .Sheets(c) = .Sheets(slast)
sflag(slast) = True
slast = slast + 1
Wend
sheetrangeStr = sheetrangeStr & "," & sFirst & ":" & slast - 1
d = slast - 1
End If
Next d
.Sheets.Add After:=Sheets(Sheets.Count)
.Sheets(Sheets.Count).Name = .Sheets(2).Cells(i, 9)
.Sheets(2).Range(rangeStr).EntireRow.Copy
Sheets(Sheets.Count).Range("A1").PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
.Sheets(2).Range(rangeStr).EntireRow.Copy
.Sheets(c).Cells((Sheets(c).UsedRange.Rows.Count) + 2, 1).PasteSpecial Paste:=xlPasteAll, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End If
Next c
End If
Next i
End With
ThisWorkbook.Sheets(2).Select
Cells(1, 1).Select
Application.CutCopyMode = False
MsgBox ("Success!")
End Sub
I'm a complete noob and i am working with re-engineered code that i don't completely understand (that was supplied from this forum
). Any help to sort this this mess out would be greatly appreciated.
Here is a sample copy of the Excel file.
Bookmarks