As per your example, since your Dim Loc As String is inside the event Sub Worksheet_SelectionChange it will inizialize (to empty) everytime the event triggers. Move the Dim just before the Sub and your variable will retain the last input.
If you put the Call inside the If/Then, and you are clicking outside the range, the Call will never execute; therefore A1 will not change.
Here is where LocVar gets assigned:
If Not Intersect(Target, Range("F9")) Is Nothing Then
Range("A" & Sheets("VBA Data").Range("O35")).Select '<---- takes user where he needs to be
LocVar = "AFR"
End Ifbut when you get to the Second Step, since your macro has skipped First Step because you aren't in cell F9, LocVar will not be assigned, that's why when you are in cells N103-N130 your variable will result empty.
For j = 0 To 27 '28 day planning horizon
If Not Intersect(Target, Range("N" & 103 + j)) Is Nothing Then
Dt_Req = Target.Value
'Call Loc_Summary(LocVar, Dt_Req)
MsgBox LocVar & " , " & Dt_Req '<- - - - - - -now, the box shows ", 02/05/2022" What made LocVar disappear ?? Retriggering the event ?
End If ' ^-------------------------^
NextThanks for the positive feedback
, glad having been of some help.
This is the snippet I usually use with VBE:
Option Explicit
Sub CheckOfficeVersion()
#If Win64 Then
MsgBox "64-bit Microsoft Office"
#Else
MsgBox "32-bit Microsoft Office"
#End If
End SubYou could work on something like this:
For Each cell In Sheets("MySheet").Columns(17).Cells
Select Case cell.Value
Case "-29.75"
If cell.Offset(0, -6) = "02-01-2022" Then
cell.Offset(0, 2).Value = "-8.33"
ElseIf cell.Offset(0, -6) = "03-01-2022" Then
cell.Offset(0, 2).Value = "-10.50"
End If
End Select
NextThanks for the positive feedback, glad having been of some help.
Should be better:
Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, ActiveCell.Column)).Copy
Have a try with my macro to be pasted in the sheet's module (the one with the dropdowns) and change the date format of the time-stamp if necessary:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Column = 6 Or Target.Column = 8 Or Target.Column = 10) Then Target.Offset(0, 1) = Format(Now, "mm/dd/yyyy hh:mm:ss")
Application.EnableEvents = True
End SubMaybe:
Range(ActiveCell, Cells(ActiveCell.Row)).CopyThanks for the positive feedback, glad having been of some help.
Yes that's right; as you may understand, the data is too long or too wide to fit in one page, you must decide, or reduce the hight of the rows or reduce the width of the columns in your sheet. Then you can go back to:
.FitToPagesWide = 1
.FitToPagesTall = 1Instead of this:
lr = pasteSheet.Range("D" & Rows.Count).End(xlUp).Rowuse this:
lr = pasteSheet.Range("D1:K" & Rows.Count).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).RowI would suggest using:
.FitToPagesWide = 1
.FitToPagesTall = FalseYou're welcome 
.
Sorry, but this time it's better to start a new thread, the title of this one has nothing to do with this last request.
My suggestion without knowing any thing about you project:
With the help of your Function, before updating column B I would copy the old data from column B into a hidden helper column (maybe somewhere in the sheet, in your example lets say column H) and only then update column B. With a formula in column C compare new data in column B against old data in the hidden column. Formula for column C:
=IF(B7<>H7,"Delta","")
If you can't make any changes to your Function just have the copy of the old data done by the macro you have showen above.
If you are using ws Array you will only pick from here, elsewise you could change your macro and add a If/Then, something like this:
If Sheets.Name <> "PROFORMA DRYHIRE" Then
'do something
End IfSorry, found a typo, missed a reference to sheet, change this:
Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copyto (note the leading dot):
.Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).CopyThat's because you are activating the sheets Sheet(ws(i)).Activate to fetch the data and the last activated sheet will be the last of the ws Array so it's the "3. ...". It isn't necessary to activate a sheet to fetch data from it; just give the right reference to the ranges used.
Now, first of all get rid of the trailing spaces in the sheet names, they only create confusion since they aren't visible.
Then try this:
Option Explicit
Sub BuildInvoiceAll()
Dim ws As Variant, sht As Variant
Dim i As Long, lr As Long, nr As Long, c As Long
Dim cell As Range
Application.ScreenUpdating = False
' Set array of worksheet names to copy from
ws = Array("1.Power Distribution - Dimmer", "2.POWER CABLES - ADAPTORS", "3.CABLES (OTHER) - CABLE CROSS")
' Array of columns to check
sht = Array("D")
nr = 15
Sheets("PROFORMA DRYHIRE").Range("A15:C70").ClearContents
' Loop through all sheets in sheets array
For i = LBound(ws) To UBound(ws)
' Loop through all columns in the column array
For c = LBound(sht) To UBound(sht)
' Find last row in column with data
With Sheets(ws(i))
lr = .Cells(Rows.Count, sht(c)).End(xlUp).Row
' Loop through all cells in column
For Each cell In .Range(.Cells(1, sht(c)), .Cells(lr, sht(c)))
' Check to see if value is numeric and not 0
If (IsNumeric(cell.Value)) And (cell.Value <> 0) Then
' Copy cells C, D, E to columns A, B, C of main sheet
Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy
Sheets("PROFORMA DRYHIRE").Cells(nr, "A").PasteSpecial Paste:=xlPasteValues
' Increment nr counter
nr = nr + 1
' Check to see if rows are full
If nr > 70 Then
MsgBox "Rows are full"
Exit Sub
End If
End If
Next cell
End With
Next c
Next i
Application.ScreenUpdating = True
MsgBox "Macro complete - Data Stored!"
End SubDo you mean that every sheet has to create it's own template ? Just get rid of the ws Array and the cycle For i.
Just set a variable (ws) to read the name of the sheet from which you launch the macro.
Also I would close the template just after saving it if you don't need it straight away (see note in macro).
Option Explicit
Sub BuildTemplateINm()
Dim nr As Long
Dim cell As Variant
Dim lr As Long
Dim N$
Dim ws As String
ws = ActiveSheet.Name
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Loop through all sheets in sheets array
Sheets.Add.Name = "NewSheet"
Range("A1").Value = "Description"
Range("B1").Value = "Quantity"
nr = 2
With Sheets(ws)
' Find last row in column with data
lr = .Cells(Rows.Count, "D").End(xlUp).Row
' Loop through all cells in column
For Each cell In .Range(.Cells(1, "D"), .Cells(lr, "D"))
' Check to see if value is numeric and not 0
If (IsNumeric(cell.Value)) And (cell.Value <> 0) Then
' Copy cells C, D, E to columns A, B, C of newsheet
.Range(.Cells(cell.Row, "C"), .Cells(cell.Row, "E")).Copy
Sheets("NewSheet").Cells(nr, "A").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' Increment nr counter
nr = nr + 1
End If
Next cell
End With
' Name and Save newsheet
N = ActiveWorkbook.Path & "\" & ws & ".xlsx"
Sheets("NewSheet").Move
ActiveWorkbook.SaveAs N, 51
ActiveWorkbook.Close '<- delete if you need the new template open
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Done! " & ws & " template created."
End Sub