so I know this error has been asked about time and time again but I couldn't find one which replicates the issue I am having.
The following is declared in the PERSONAL.XLSB workbook so I can easily use the macro on different projects. The error started popping when I added the second If block in the for loop, note that this macro worked as expected before the aforementioned addition.
Sub AddNote()
Dim Dict As New Scripting.Dictionary
Dict.Add "101-104", "Includes 101, 102, 103, 104"
Dict.Add "061, 071", "Includes 061, 071"
Dict.Add "076, 077, 081", "Includes 076, 077, 081"
Dict.Add "111, 112, 113, 221, 222", "Includes 111, 112, 113, 221, 222"
Dict.Add "111, 112, 221, 222", "Includes 111, 112, 221, 222"
Dict.Add "111-115, 221, 222", "Includes 111, 112, 113, 114, 115, 221, 222"
Dict.Add "101-104 Early", "Includes 101, 102, 103, 104"
Dict.Add "101-104 Late", "Includes 101, 102, 103, 104"
Dict.Add "101-104 Mid", "Includes 101, 102, 103, 104"
Dict.Add "111-115, 221, 222 Early", "Includes 111, 112, 113, 114, 115, 221, 222"
Dict.Add "111-115, 221, 222 Late", "Includes 111, 112, 113, 114, 115, 221, 222"
Dict.Add "161-164", "Includes 161, 162, 163, 164"
Dict.Add "161-164 Early", "Includes 161, 162, 163, 164"
Dict.Add "161-164 Late", "Includes 161, 162, 163, 164"
Dict.Add "131, 132", "Includes 131, 132"
Dict.Add "062, 064, 066-068", "Includes 062, 064, 066, 067, 068"
Dict.Add "078, 104, 105-107", "Includes 078, 104, 105, 106, 107"
Dict.Add "104, 108, 121", "Includes 104, 108, 121"
Dict.Add "231, 241, 242", "Includes 231, 241, 242"
Dict.Add "072, 074", "Includes 072, 074"
Dict.Add "231, 241, 242 Early", "Includes 231, 241, 242"
Dict.Add "231, 241, 242 Late", "Includes 231, 241, 242"
Dict.Add "114, 115", "Includes 114, 115"
Dim Rng As Range
Dim ws1 As Worksheet
Set ws1 = Sheets("BY HUNT")
Set Rng = ws1.Range("A2:A162")
For Each cell In Rng
If Dict.Exists(VBA.Trim(cell)) Then
ws1.Range("AA" & cell.Row).Value = Dict.Item(VBA.Trim(cell.Value))
End If
If VBA.Trim(cell.Value) Like "*Early*" Then
wsl.Range("Z" & cell.Row).Value = "Early"
ElseIf VBA.Trim(cell.Value) Like "*Late*" Then
wsl.Range("Z" & cell.Row).Value = "Late"
ElseIf VBA.Trim(cell.Value) Like "*Mid*" Then
wsl.Range("Z" & cell.Row).Value = "Mid"
Else
wsl.Range("Z" & cell.Row).Value = "All"
End If
Next cell
End Sub
I'm not overly experienced with VBA but I did read the other questions I found on here related to mine, and none bore fruit. I don't understand why I would be able to mess with the value in the first if statement but in the second I get the error mentioned in the title. Debug points to the line in the else clause, if I remove that one the debug just points to another line in that second if block. Any direction would be much appreciated.
Edit: Moving this macro to the actual workbook did not fix the error
Add Option Explicit to the top of your module and recompile. You have typos in your variable names. ws1 vs wsl
Related
I have a vba script i am working on. It applies a time stamp each time the relevant cell is double clicked. Once its double clicked the cells are locked.
When the cell is double clicked on again a pop up box appears requesting a password, which is fine.
Problem: However i want the cell to be left unprotected until it gets double clicked again.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30 - 35, 37, 38, 40, 42 - 44, 54 - 56, 58, 59, 61 - 65
ActiveSheet.Protect Password:="Test", userinterfaceonly:=True
.Value2 = "Prepared By" & " " & Environ("Username")
.Value2 = .Value2 & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
.Locked = True
ActiveSheet.Unprotect
End Select
End If
End With
Edited as per below answer , however user is able double click the protect cell which still changes regards password is entered or not.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
If InStr(1, Target.Value2, "##") = 0 Then
Target.Value2 = Target.Value2 & "##"
Else
ActiveSheet.Protect Password:="Test", userinterfaceonly:=True
.Value2 = "Prepared By" & " " & Environ("Username")
.Value2 = .Value2 & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
.Locked = True
ActiveSheet.Unprotect
End If
End Select
End If
End With
I have been doing a little bit of research if its possible to highlight cells which have been manually amended (by typing in the information) as oppose via marco. What i really came across was track changes which might not apply in this situation
Scenario
I have a macro which runs each time certain cells are double clicked. When a cell is double clicked a timestamp is provided, which is perfectly fine.
Problem
I am trying to aviod the situation were a user tries to amend the time stamp manually, or any of that information in that relevant cell. I am trying to aviod using the methdology of locking cells once update.
Solution to be achieved.
Is it possible that if a cell has been manually updated by user that its highlighted. However if it has been update through the use of the macro thats ok.
Code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
.Value2 = "Prepared By" & " " & Environ("Username")
.Value2 = .Value2 & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
End Select
End If
End With
The simplest solution to this would just to be enforce any changes to your selected cells with the change event. I assume the double click aspect is to make it more user friendly for the input so we won't remove that, rather duplicate it:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
.Value2 = "Prepared By" & " " & Environ("Username") & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
End Select
End If
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
If Target.Cells.Count = 1 Then
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
.Value2 = "Prepared By" & " " & Environ("Username") & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
End Select
End If
End With
Else
For Each cell In Target.Cells
With cell
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
.Value2 = "Prepared By" & " " & Environ("Username") & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
End Select
End If
End With
Next cell
End If
End Sub
I am currently working with two pieces of vba code. I am trying to marry them together to achieve the below purpose.
First code
I have code that allows users to double click on a cell and then it time stamps the cell, and subsequently locks the relevant cell. Which works fine. However is some instances the user will have to type in NA and different piece of code will run ( Second code).
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
Sheets("Sheet3").Protect Password:="Test", userinterfaceonly:=True
.Value2 = "Prepared By" & " " & Environ("Username")
.Value2 = .Value2 & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
.Locked = True
End Select
End If
End With
End Sub
Second Code when user Types NA
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'// Check if the target row number is in our array:
Select Case Target.Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
' Do Something
If CStr(Target.Value) Like "*NA*" Then
Target.Value = "Not applicable" & " " & Environ("Username") & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
End If
Case Else
' Do nothing
Exit Sub
End Select
End Sub
Problem to Overcome
Once the user double clicks on a the cell and it locks , there are not able to later change that cell to NA. NA should be the only value that the user should be able to type once cell is locked.
Question
Is there a way that i can allow the user to type in NA only once the cell is locked. Therefore user only has two options to type na or Double click
Obviously you can't type anything until a cell is locked. Add data validation to allow "NA" only instead of locking the cell. Something like this:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Application.EnableEvents = False
With Target
If .Column = 4 Then
Select Case .Row
Case 20, 24, 25, 27, 28, 30, 31, 32, 33, 34, 35, 37, 38, 40, 42, 43, 44, 54, 55, 56, 58, 59, 61, 62, 63, 64, 65
.Value2 = "Prepared By" & " " & Environ("Username") & " " & Format(Now, "yyyy-MM-dd hh:mm:ss")
With .Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="NA"
.IgnoreBlank = False
.InCellDropdown = False
.ErrorTitle = "Invalid input"
.ErrorMessage = "NA available only"
.ShowError = True
End With
End Select
End If
End With
Application.EnableEvents = True
End Sub
This method assumes that the worksheet isn't protected at all.
I apologize if this has been answered before but I have had no luck in finding a viable solution to my quandary.
I am attempting to fix/enhance one of the tools we use by coloring different ranges different colors but only the rows that are used by the data being populated. I have been able to find a solution that works but for some reason it is coloring many more rows than I want it to. If I'm populating only a few rows it colors over 80 rows. The more rows I use the more rows it colors and I haven't had any luck finding out why.
The tool populates columns A-AS and starts on row 9. It is populated with data from a different tab. My tests have been unsuccessful to say the least. Here is what the tool looks like:
Quote Builder:
Here is a snippet of the code I'm working with:
' Color used range of cells
Sheet1.Range("A9:G9" & LastRowNo).Interior.Color = RGB(255, 242, 204)
Sheet2.Range("A9:G9" & LastRowNo).Interior.Color = RGB(255, 242, 204)
Sheet1.Range("H9:M9" & LastRowNo).Interior.Color = RGB(252, 228, 214)
Sheet2.Range("H9:M9" & LastRowNo).Interior.Color = RGB(252, 228, 214)
Sheet1.Range("N9:AI9" & LastRowNo).Interior.Color = RGB(226, 239, 218)
Sheet2.Range("N9:AI9" & LastRowNo).Interior.Color = RGB(226, 239, 218)
Sheet1.Range("AJ9:AS9" & LastRowNo).Interior.ColorIndex = 17
Sheet2.Range("AJ9:AS9" & LastRowNo).Interior.ColorIndex = 17
Please let me know if you need more information, I tried to be as specific as I could.
To clarify to all that are trying to help with this issue. The code above works except that it is coloring more rows than I need it to by a significant amount. I only need it to color the used rows starting at row 9 going down to how ever many lines the user populates. This could be as few as 1 line to well over 200 lines. Basically, however many lines are needed by the user. Thanks to all in advance.
Here are the changes I've made that is a lot closer to what I need but still not all the way there:
' Color used range of cells
Sheet1.Range("A9:G1" & LastRowNo).Interior.Color = RGB(255, 242, 204)
Sheet2.Range("A9:G1" & LastRowNo).Interior.Color = RGB(255, 242, 204)
Sheet1.Range("H9:M1" & LastRowNo).Interior.Color = RGB(252, 228, 214)
Sheet2.Range("H9:M1" & LastRowNo).Interior.Color = RGB(252, 228, 214)
Sheet1.Range("N9:AI1" & LastRowNo).Interior.Color = RGB(226, 239, 218)
Sheet2.Range("N9:AI1" & LastRowNo).Interior.Color = RGB(226, 239, 218)
Sheet1.Range("AJ9:AS1" & LastRowNo).Interior.ColorIndex = 17
Sheet2.Range("AJ9:AS1" & LastRowNo).Interior.ColorIndex = 17
Okay, I was able to come up with a solution that works for my situation. I had to add an If statement as it wouldn't color the first row if there was only one row of data. Now it works exactly as I wanted it to.
Here is the code I used:
' Color used range of cells
If LastRowNo = 2 Then
Sheet1.Range("A9:G9").Interior.Color = RGB(255, 242, 204)
Sheet2.Range("A9:G9").Interior.Color = RGB(255, 242, 204)
Sheet1.Range("H9:M9").Interior.Color = RGB(252, 228, 214)
Sheet2.Range("H9:M9").Interior.Color = RGB(252, 228, 214)
Sheet1.Range("N9:AI9").Interior.Color = RGB(226, 239, 218)
Sheet2.Range("N9:AI9").Interior.Color = RGB(226, 239, 218)
Sheet1.Range("AJ9:AS9").Interior.ColorIndex = 17
Sheet2.Range("AJ9:AS9").Interior.ColorIndex = 17
Else
Sheet1.Range("A9:G" & LastRowNo + 7).Interior.Color = RGB(255, 242, 204)
Sheet2.Range("A9:G" & LastRowNo + 7).Interior.Color = RGB(255, 242, 204)
Sheet1.Range("H9:M" & LastRowNo + 7).Interior.Color = RGB(252, 228, 214)
Sheet2.Range("H9:M" & LastRowNo + 7).Interior.Color = RGB(252, 228, 214)
Sheet1.Range("N9:AI" & LastRowNo + 7).Interior.Color = RGB(226, 239, 218)
Sheet2.Range("N9:AI" & LastRowNo + 7).Interior.Color = RGB(226, 239, 218)
Sheet1.Range("AJ9:AS" & LastRowNo + 7).Interior.ColorIndex = 17
Sheet2.Range("AJ9:AS" & LastRowNo + 7).Interior.ColorIndex = 17
End If
If this helps anyone else then it was worth the effort. If there are other solutions or a better way of doing this then please add your information. I come to this site often to find solutions to issues and find it to be one of the most beneficial sites around. Thanks to those that offered their input in this, it was helpful.
I have written some code that populates a preformatted worksheet in an another workbook, from another preformatted worksheet. They include merged cells and all other things nasty, and for whatever reason cannot be changed.
So, I have written the following
Sub test()
Dim wbkCurrent As Workbook
'Dim wbk3Mth As Workbook
Dim wbk6Mth As Workbook
Set wbkCurrent = ThisWorkbook
Set wbk6Mth = Workbooks.Open("C:\newbook.xlsm")
newbook.Sheets("Mon 1").Activate
Call assignArrays
End Sub
Sub assignArrays
Call moveValues(32, 3, 7, 8)
Call moveValues(32, 5, 23, 6)
Call moveValues(32, 65, 15, 8)
Call moveValues(32, 56, 31, 5)
Call moveValues(32, 57, 31, 11)
Call moveValues(32, 15, 39, 4)
Call moveValues(32, 16, 39, 5)
Call moveValues(32, 17, 39, 6)
Call moveValues(32, 18, 39, 7)
Call moveValues(32, 30, 39, 10)
Call moveValues(32, 31, 39, 11)
Call moveValues(32, 32, 39, 12)
Call moveValues(32, 33, 39, 13)
Call moveValues(32, 7, 7, 21)
Call moveValues(32, 9, 23, 19)
Call moveValues(32, 66, 15, 21)
Call moveValues(32, 59, 31, 18)
Call moveValues(32, 60, 31, 24)
Call moveValues(32, 20, 39, 17)
Call moveValues(32, 21, 39, 18)
Call moveValues(32, 22, 39, 19)
Call moveValues(32, 23, 39, 20)
Call moveValues(32, 35, 39, 23)
Call moveValues(32, 36, 39, 24)
Call moveValues(32, 37, 39, 25)
Call moveValues(32, 38, 39, 26)
Call moveValues(32, 11, 7, 34)
Call moveValues(32, 13, 23, 32)
Call moveValues(32, 67, 15, 34)
Call moveValues(32, 62, 31, 31)
Call moveValues(32, 63, 31, 37)
Call moveValues(32, 25, 39, 30)
Call moveValues(32, 26, 39, 31)
Call moveValues(32, 27, 39, 32)
Call moveValues(32, 28, 39, 33)
Call moveValues(32, 40, 39, 36)
Call moveValues(32, 41, 39, 37)
Call moveValues(32, 42, 39, 38)
Call moveValues(32, 43, 39, 39)
End Sub
Sub moveValues(tRow, tCol, rRow, rCol)
'trow is row in this workbook, tcol is column in this workbook, rRow & rCol are the same for the other workbook
ActiveSheet.Cells(rRow, rCol).Value = ThisWorkbook.Sheets("Results").Cells(tRow, tCol).Value
tRow = tRow + 1
rRow = rRow + 1
ActiveSheet.Cells(rRow, rCol).Value = ThisWorkbook.Sheets("Results").Cells(tRow, tCol).Value
tRow = tRow + 1
rRow = rRow + 1
ActiveSheet.Cells(rRow, rCol).Value = ThisWorkbook.Sheets("Results").Cells(tRow, tCol).Value
tRow = tRow + 1
rRow = rRow + 1
ActiveSheet.Cells(rRow, rCol).Value = ThisWorkbook.Sheets("Results").Cells(tRow, tCol).Value
tRow = tRow + 1
rRow = rRow + 1
ActiveSheet.Cells(rRow, rCol).Value = ThisWorkbook.Sheets("Results").Cells(tRow, tCol).Value
tRow = tRow + 1
rRow = rRow + 1
ActiveSheet.Cells(rRow, rCol).Value = ThisWorkbook.Sheets("Results").Cells(tRow, tCol).Value
End Sub
This works fine, and writes all the data out. Problem is, I need this to run starting where
trow = 2,12,22,32,42,52
Now I could write this all out manually, but it would mean that going in and changing it later would be a nightmare. So, I had the idea of using a = 2,12,22,32 etc and then having
call moveValues(a, 3, 7, 8)
However this means a bumps up a digit through the moveValues subroutine, and needs resetting each time.
I have one idea to solve this using arrays, but that has its own issues.
I replaced the module assignArrays with
Sub assignArrays()
'row in this workbook
Dim array1(5)
array1(5) = Array(2, 12, 22, 32, 42, 52)
'E
Dim array2(12)
array2(12) = Array(3, 5, 65, 56, 57, 15, 16, 17, 18, 30, 31, 32, 33)
'U
Dim array2_1(12)
array2_1(12) = Array(7, 9, 66, 59, 60, 20, 21, 22, 23, 35, 36, 37, 38)
'R
Dim array2_2(12)
array2_2(12) = Array(11, 13, 67, 62, 63, 25, 26, 27, 28, 40, 41, 42, 43)
'row in report
Dim array3(12)
array3(12) = Array(7, 23, 15, 31, 31, 39, 39, 39, 39, 39, 39, 39, 39) 'constant in each array 1
'column in report
Dim array4(12)
array4(12) = Array(8, 6, 8, 5, 11, 4, 5, 6, 7, 10, 11, 12, 13) '+13 for each third
Dim v1, v2, v3, v4 As Integer
For a = 0 To 5
v1 = array1(a)
For b = 0 To 12
v3 = array3(b)
For c = 0 To 12
v4 = array4(c)
For d = 0 To 12
v2 = array2(d)
Call moveValues(v1, v2, v3, v4)
Next d
Next c
For c = 0 To 12
v4 = array4(c) + 13
For d = 0 To 12
v2 = array2(d)
Call moveValues(v1, v2, v3, v4)
Next d
Next c
For c = 0 To 12
v4 = array4(c) + 26
For d = 0 To 12
v2 = array2(d)
Call moveValues(v1, v2, v3, v4)
Next d
Next c
Next b
Next a
End Sub
This dies with a 1004 error on the first line of moveValues. Any ideas to fix either solution?
You are not dealing with arrays properly.
Dim array1(5) 'Array with 5 dimension
array1(5) = Array(2, 12, 22, 32, 42, 52) 'Write all this content to the fifth position
The proper way to do that is:
Dim array1(5) As Integer
array1(0) = 2
array1(1) = 12
array1(2) = 22
array1(3) = 32
array1(4) = 42
array1(5) = 52
If you want to rely on one line, you can do:
Dim array1
array1 = Array(2, 12, 22, 32, 42, 52) 'In this case, it starts from 0 -> pretty unconventional (bear in mind that the array above is dimensioned from 1)
---- UPDATE
What your code delivers:
Dim array1(5)
array1(5) = Array(2, 12, 22, 32, 42, 52)
Dim test1 As Integer: test1 = array1(0) '-> 0
Dim test2 As Integer: test2 = array1(1) '-> 0
Dim test3 As Integer: test3 = array1(2) '-> 0
Dim test4 As Integer: test4 = array1(3) '-> 0
Dim test5 As Integer: test5 = array1(4) '-> 0
Dim test6 As Integer: test6 = array1(5) 'ERROR
What my code delivers:
Dim array1
array1 = Array(2, 12, 22, 32, 42, 52)
Dim test1 As Integer: test1 = array1(0) '-> 2
Dim test2 As Integer: test2 = array1(1) '-> 12
Dim test3 As Integer: test3 = array1(2) '-> 22
Dim test4 As Integer: test4 = array1(3) '-> 32
Dim test5 As Integer: test5 = array1(4) '-> 42
Dim test6 As Integer: test6 = array1(5) '-> 52