melodramatic
Board Regular
- Joined
- Apr 28, 2003
- Messages
- 180
- Office Version
- 365
- Platform
- Windows
Yes, we're slow at work, so I'm building like crazy. Thanks to all of you who have helped me out the last few weeks with my "still learning" problems!
I've created a macro that will take standardized charge sheets for rentals, and copy them, showing the client, etc. per our engineer's data table that he creates.
Everything in the macro works fine, EXCEPT for the replacing of variable markers to be replaced by variables. When the sheets are complete, the markers are still there instead of the project data.
I know that I had a similar problem earlier this month, which was solved by making the changes in a "With Worksheets(…) layout, but I don't know how to do that when I don't know the addresses for the markers (there are 5 different rental sheets, and each one has a different layout).
So, here goes - hopefully you can tell me what I am doing wrong here...
The full macro is as follows (the trouble code is about 3/4 of the way down):
I've created a macro that will take standardized charge sheets for rentals, and copy them, showing the client, etc. per our engineer's data table that he creates.
Everything in the macro works fine, EXCEPT for the replacing of variable markers to be replaced by variables. When the sheets are complete, the markers are still there instead of the project data.
I know that I had a similar problem earlier this month, which was solved by making the changes in a "With Worksheets(…) layout, but I don't know how to do that when I don't know the addresses for the markers (there are 5 different rental sheets, and each one has a different layout).
So, here goes - hopefully you can tell me what I am doing wrong here...
Code:
'Replace datapoints with variables - THIS IS WHERE I'M HAVING MY ISSUES ON THE CODE BELOW
Set r = ActiveSheet.Range("A1:M10")
r.Replace "PNPN", PN
Set r = ActiveSheet.Range("A1:M10")
r.Replace "CLIENTCLIENT", Client
Set r = ActiveSheet.Range("A1:M10")
r.Replace "DATEDATE", WeekEndingThe full macro is as follows (the trouble code is about 3/4 of the way down):
VBA Code:
Private Sub CommandButton1_Click()
' This macro creates worksheets for all active projects (per the list)
' Written by Melody October May
' Created May 26, 2020
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Pwd As String
Dim Confirmation As Integer
Dim WeekEnding As Date
Dim CountTabs As Long
Dim PNrow As Long
Dim PN As Long
Dim Phase As String
Dim Lab As String
Dim PM As String
Dim Client As String
Dim WorkTab As String
Dim AfterTab As String
Dim r As Range
Dim cellrange As Range
Dim cellrow As Range
Dim cellcol As Range
Pwd = Range("M2")
'Make sure that a date is selected, and if so, that the date is correct
If Range("C1") = "Select Week-End Date:" Then
MsgBox "You must select a week ending date for this file before continuing. See Cell C1."
Exit Sub
End If
WeekEnding = Range("C1")
CountTabs = 0
'Sort Table to PN.Phase.Lab
ActiveSheet.Unprotect Password:=Pwd
ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort.SortFields. _
Add2 Key:=Range("Table_PNs[[#All],[Lab]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort.SortFields. _
Add2 Key:=Range("Table_PNs[[#All],[Phase]]"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort.SortFields. _
Add2 Key:=Range("Table_PNs[[#All],[PN]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Projects").ListObjects("Table_PNs").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.Protect Password:=Pwd
For PNrow = Range("M3") + 1 To Range("M4")
If Range("G" & PNrow) = "READY TO CREATE TAB" Then
PN = Range("A" & PNrow)
Phase = Range("B" & PNrow)
Lab = Range("C" & PNrow)
PM = Range("E" & PNrow)
Client = Range("F" & PNrow)
WorkTab = Range("J" & PNrow)
AfterTab = Range("K" & PNrow)
Sheets(Lab).Visible = True
Sheets(Lab).Select
Application.CopyObjectsWithCells = False
ActiveSheet.Copy After:=ActiveWorkbook.Sheets(AfterTab)
ActiveSheet.Name = WorkTab
'Replace datapoints with variables - THIS IS WHERE I'M HAVING MY ISSUES ON THE CODE BELOW
Set r = ActiveSheet.Range("A1:M10")
r.Replace "PNPN", PN
Set r = ActiveSheet.Range("A1:M10")
r.Replace "CLIENTCLIENT", Client
Set r = ActiveSheet.Range("A1:M10")
r.Replace "DATEDATE", WeekEnding
'Mark Tab as Created; Create Hyperlink
Sheets("Projects").Select
ActiveSheet.Unprotect Password:=Pwd
Range("H" & PNrow).Value = "P"
Range("A" & PNrow).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & WorkTab & "'!A1"
With Selection.Font
.Size = 12
End With
With Selection
.HorizontalAlignment = xlCenter
End With
ActiveSheet.Protect Password:=Pwd
CountTabs = CountTabs + 1
Sheets(Lab).Visible = xlVeryHidden
End If
Next PNrow
CommandButton5.Caption = "Unprotect This Worksheet"
MsgBox "Setting up Lab Rental Sheets is Complete. " & CountTabs & " lab rental sheets have been set up."
End Sub
