• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to correct the sequential number for generated multiple workbooks

sgwarrior

New Member
Hi all,

I have an existing macro that filters based on a user selected column from a worksheet. For example, if the column data has "20 departments", the macro will do an auto filter and generate 20 worksheets for each department.

So I will have Dept A.xls, Dept B.xls, Dept C.xls and so on (depending on how many departments listed in that particular column within the master data worksheet).

View attachment 84265

Below is the VB code that generates the worksheets:
-------------------------------------------------------------
>>> use code - tags <<<
Code:
Sub S_Frm()

'Disbale screen updating for speedup macros working
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False
'Application.Calculation = xlCalculationManual
On Error Resume Next

Dim GetPath As String
With Application.FileDialog(msoFileDialogFolderPicker)

If .Show <> 0 Then

GetPath = .SelectedItems(1)

'Variables for worksheet , lastrow & lastcolumn of database

Dim WS As Worksheet, LR As Long, LC As Long, IB As String, SColmn As String, LastSheet As Long, Year As String, columnName As String, AnswerYes As String, AnswerNo As String, Setpassword As String, columnNumber As Integer
Set WS = ThisWorkbook.Sheets("Master")
LR = WS.Range("A" & Rows.Count).End(xlUp).Row
LC = WS.Cells(3, Columns.Count).End(xlToLeft).Column

WS.Activate
IB = Application.InputBox("Please select the column you want to split data based on")
SColumn = "" & IB & ":" & IB & ""

WS.Range(SColumn).Copy: WS.Columns("Z:Z").PasteSpecial xlPasteValues
LastSheet = WS.Range("Z" & Rows.Count).End(xlUp).Row

WS.Range("AA3").Formula = "=SUBSTITUTE(RC[-1],""/"",""-"")"
WS.Range("AA3").AutoFill Destination:=Range("AA3:AA" & LastSheet)

WS.Columns("Z:AA").RemoveDuplicates Columns:=1, Header:=xlYes
WS.Columns("AA:AA").Copy: WS.Columns("AA:AA").PasteSpecial xlPasteValues

LastSheet = WS.Range("Z" & Rows.Count).End(xlUp).Row
Year = InputBox("Please enter the words you want to add to the filename.")

columnName = SColumn
columnNumber = Range(columnName).Column

For A = 4 To LastSheet

WS.Cells(3, SColumn).AutoFilter Field:=columnNumber, Criteria1:=WS.Cells(A, 26)
Workbooks.Add
WS.Range("A1:Y" & LR).Copy
ActiveSheet.Range("A1").Select
ActiveSheet.Paste

ActiveSheet.Name = WS.Cells(A, 26)
Columns("Z:AA") = vbNullString
'ActiveWorkbook.SaveAs Filename:=WS.Cells(A, 27) & " - LSA 2023"

Dim path As String
path = GetPath & ""
ActiveWorkbook.SaveAs path & WS.Cells(A, 27) & Year & ".xlsx", FileFormat:=xlOpenXMLWorkbook

ActiveSheet.Columns("A:Z").AutoFit

ActiveWorkbook.Save
ActiveWorkbook.Close

Next A
ThisWorkbook.Activate
WS.AutoFilterMode = False
MsgBox "workbooks have been generated successfully"
Sheets(1).Select
End If
End With

AnswerYes = MsgBox("Do you wish to set a Password?", vbQuestion + vbYesNo, "User Repsonse")

If AnswerYes = vbYes Then
Setpassword = InputBox("Please enter the password.")
AddPassword path, Setpassword
MsgBox "Password successfully set in all worksheets!"
Else
MsgBox ("Okay, no password is required to open the worksheets")
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

End Sub
-------------------------------------------------------------

My issue is that the generated worksheets s/no number is no longer in sequence.

View attachment 84266

How do I add in the necessary vba code to correct the S/N number so that it runs 1, 2, 3, 4...in column A3 onwards for all generated worksheets?

Appreciate your help! thanks
 
Last edited by a moderator:
Hi, according to forum rules you must​
  • edit your initial post in order to add the code tags (via the code option from the 3 dots menu)
  • according to your cross posting add a link for every other Excel forum where you have created the same thread
  • as Excel can't work from a picture so attach at least a workbook sample …
 
sgwarrior
  • Cross-Posting. Generally, it is considered poor practice to cross post. That is to post the same question on several forums in the hope of getting a response quicker.
  • If you do cross-post, please put that in your post.
  • Also if you have cross-posted and get an Solution elsewhere, have the courtesy of posting the Solution here so other readers can learn from the answer also, as well as stopping people wasting their time on your answered question.
 
I found the solution on how to auto filter serial numbers. Basically, I added this formulae to the master sheet and it works.

=subtotal (3, $B$2:B3)
 
Back
Top