Hello all,
Can decipher this impenetrable code sufficiently to make it ignore the first row on the sheet on which it runs?
I am changing the sheet so that the control buttons take up row one.
This sub is called from a larger sub that also changes the button settings so that they are free-floating.
Many thanks in advance.
Can decipher this impenetrable code sufficiently to make it ignore the first row on the sheet on which it runs?
I am changing the sheet so that the control buttons take up row one.
This sub is called from a larger sub that also changes the button settings so that they are free-floating.
Many thanks in advance.
Code:
Option Explicit
Const sname As String = "INVRead" 'change to whatever starting sheet
Const S As String = "J" 'change to whatever criterion column
Sub columntosheetsINV()
Dim wb As Workbook
Dim Sh As Worksheet
Dim TINVRead As TableObject
Dim D As Object, A, CC&
Dim P&, i&, rws&, cls&
Set wb = ThisWorkbook
Set D = CreateObject("scripting.dictionary")
With wb.Sheets(sname)
rws = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
cls = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
CC = .Columns(S).Column
End With
For Each Sh In Worksheets
D(Sh.Name) = 1
Next Sh
Application.ScreenUpdating = False
With wb.Sheets.Add(after:=wb.Sheets(sname))
wb.Sheets(sname).Cells(1).Resize(rws, cls).Copy .Cells(1)
.Cells(1).Resize(rws, cls).Sort .Cells(CC), 2, Header:=xlYes
A = .Cells(CC).Resize(rws + 1, 1)
P = 2
For i = 2 To rws + 1
If A(i, 1) <> A(P, 1) Then
If D(A(P, 1)) <> 1 Then
'Sheets.Add.Name = A(P, 1)
Sheets.Add.Name = ValidWBNameINV(CStr(A(P, 1)))
.Cells(1).Resize(, cls).Copy Cells(1)
.Cells(P, 1).Resize(i - P, cls).Copy Cells(2, 1)
End If
P = i
End If
Next i
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End With
wb.Sheets(sname).Activate
End Sub