Some research shows that this is an actual excel concern("macro recorder not recording correctly"), have not seen any legitimate solutions though.
Posts by davesexcel
-
-
Would you be able to make that unique range dynamic?
-
Do a countif() make criteria >0
-
If you wanted to loop through the column
Display MoreCode- Sub Button2_Click()
- Dim LstRw As Long, rng As Range, c As Range
- Dim ws As Worksheet, x, y
- Set ws = ActiveSheet
- With ws
- LstRw = .Cells(.Rows.Count, "AB").End(xlUp).Row
- Set rng = .Range("AB4:AB" & LstRw)
- For Each c In rng.Cells
- x = 12 * c
- If x <= 8000000 Then
- c.Offset(, 1) = ((c * 12 - 5000000) * 0.225 + 670000) / 12
- ElseIf x > 8000000 And x <= 12000000 Then
- c.Offset(, 1) = ((c * 12 - 8000000) * 0.25 + 1345500) / 12
- Else
- c.Offset(, 1) = ""
- End If
- Next c
- End With
- 'Range("AC4").Formula = "=IFERROR(IF(AB4*12<=8000000,(AB4*12-5000000)*0.225+670000,IF(AB4*12<=12000000,(AB4*12-8000000)*0.25+1345500,)/12),"""")"
- End Sub
-
You can attach a sample workbook for better reference.
-
Can you supply a sample workbook
-
-
Your sample workbook needs to show the desired results as well.
Your sample workbook has no data in columns BI & BJ
-
Might be a good idea to supply a sample workbook so somebody can test the code.
-
Start answering questions in the forum, best way to learn
-
How would you attach a file without saving it first?
-
This will create the workbooks with variable number of worksheets.
Keep the "Rough.xlsm" workbook in a separate folder, then when running the code it will place the new workbooks in that folder.
Display MoreCode- Sub CreatWorkbooks()
- Dim wb As Workbook, bk As Workbook
- Dim cUnique As Collection
- Dim rng As Range
- Dim c As Range
- Dim sh As Worksheet
- Dim vNum As Variant
- Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
- Dim svFile As String
- Set wb = ThisWorkbook
- Set sh1 = wb.Sheets("Branch")
- With sh1
- Set rng = .Range("A3:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
- Set cUnique = New Collection
- On Error Resume Next
- For Each c In rng.Cells
- cUnique.Add c.Value, CStr(c.Value)
- Next c
- On Error GoTo 0
- For Each vNum In cUnique
- If vNum <> "Region Total" Then
- For Each sh In wb.Sheets
- With sh
- .Range("A2").AutoFilter field:=1, Criteria1:=vNum
- End With
- Next sh
- '-------------Add workbook and sheets----------------
- Set bk = Workbooks.Add
- With wb
- For Each sh In .Sheets
- With bk
- If sh.Visible Then
- .Sheets.Add after:=.Sheets(.Sheets.Count)
- ActiveSheet.Name = sh.Name
- End If
- End With
- Next sh
- End With
- Application.DisplayAlerts = False
- bk.Sheets(1).Delete
- '-------------------------------------------------
- For Each sh In wb.Sheets
- If sh.Visible = True Then
- wb.Sheets(sh.Name).UsedRange.SpecialCells(xlCellTypeVisible).Copy _
- bk.Sheets(sh.Name).Range("A1")
- End If
- Next sh
- svFile = wb.Path & "\" & vNum & ".xlsx"
- bk.SaveAs (svFile)
- bk.Close
- End If
- Next vNum
- .AutoFilterMode = False
- End With
- End Sub
-
I can get you all the workbooks into a temp folder.
Hopefully somebody can see what is wrong with my email part,
as soon as the code runs through the email part, vNum becomes empty and just goes to end sub
You are one step closer though.
Display MoreCode- Sub UsingColection()
- Dim wb As Workbook, bk As Workbook
- Dim cUnique As Collection
- Dim rng As Range
- Dim c As Range
- Dim sh As Worksheet
- Dim vNum As Variant
- Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
- Dim svFile As String
- Dim oApp As Object
- Dim oMail As Object
- Set wb = ThisWorkbook
- With wb
- Set sh1 = .Sheets("Branch")
- Set sh2 = .Sheets("ASM")
- Set sh3 = .Sheets("DBR")
- End With
- With sh1
- Set rng = .Range("A3:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
- Set cUnique = New Collection
- On Error Resume Next
- For Each c In rng.Cells
- cUnique.Add c.Value, CStr(c.Value)
- Next c
- On Error GoTo 0
- For Each vNum In cUnique
- If vNum <> "Region Total" Then
- Set bk = Workbooks.Add
- With bk
- .Sheets.Add Count:=2
- Sheets(1).Name = "Branch"
- Sheets(2).Name = "ASM"
- Sheets(3).Name = "DBR"
- End With
- .Range("A3").AutoFilter field:=1, Criteria1:=vNum
- sh2.Range("A2").AutoFilter field:=1, Criteria1:=vNum
- sh3.Range("A3").AutoFilter field:=1, Criteria1:=vNum
- End If
- With bk
- sh1.UsedRange.SpecialCells(xlCellTypeVisible).Copy .Sheets(1).Range("A1")
- sh2.UsedRange.SpecialCells(xlCellTypeVisible).Copy .Sheets(2).Range("A1")
- sh3.UsedRange.SpecialCells(xlCellTypeVisible).Copy .Sheets(3).Range("A1")
- Application.DisplayAlerts = 0
- svFile = Environ("Temp") & "\" & vNum & ".xlsx"
- .SaveAs (svFile)
- .Close
- End With
- fname = svFile
- ' Set oMail = CreateObject("Outlook.Application").CreateItem(0)
- ' With oMail
- ' .To = "[email protected]"
- ' .Subject = "This is " & vNum
- ' .Attachments.Add fname
- ' .Display
- ' End With
- Next vNum
- Set oMail = Nothing
- End With
- End Sub
-
Supply a sample workbook.
-
OPERATION:=XLNON,
xlnone is spelled wrong
-
If there is an error, you wouldn't know because of the error trap, stop the error trap to see if there is an error.(line 5) comment out
-
-
To mark the thread solved, click on "Settings" in your response and then click "Mark as Resolved".
-
Please mark as solved
-
Me.Controls("xx" & c).Caption
From what I see there is no control xx1, xx2, xx3.
Maybe at one time there were labels named xx1,xx2,xx3.... from where you originally got the code.