I am having difficulty setting Ranges and cells to a blank value on different worksheets, UNLESS the worksheet is visible.
The code is as follows:
Sub Clean_Up_Ranges()
Dim nm As Worksheet
On Error Resume Next
For Each nm In Worksheets
Worksheets("nm").Select
Range("d7:d37") = ""
Range("k7:k37") = ""
Range("L40:l42") = ""
'..... plenty more ranges
Range("h80:j179") = ""
Calculate
Debug.Print nm.Name
Next
On Error GoTo 0
End Sub
Any ideas appreciated.
Explicitly reference the sheet.
Sub Clean_Up_Ranges()
Dim nm As Worksheet
On Error Resume Next
For Each nm In Worksheets
'Worksheets("nm").Select
nm.Range("d7:d37") = ""
nm.Range("k7:k37") = ""
nm.Range("L40:l42") = ""
'..... plenty more ranges
nm.Range("h80:j179") = ""
Calculate
Debug.Print nm.Name
Next
On Error GoTo 0
End Sub
You can use Activate keyword in your code which will activate the sheet.
See This to know difference between SHEETS.SELECT or SHEETS.ACTIVATE.
Sub Clean_Up_Ranges()
Dim nm As Worksheet
On Error Resume Next
For Each nm In Worksheets
nm.Activate 'Activate the sheet
Range("d7:d37") = ""
Range("k7:k37") = ""
Range("L40:l42") = ""
'..... plenty more ranges
Range("h80:j179") = ""
Calculate
Debug.Print nm.Name
Next
On Error GoTo 0
End Sub
Related
I am currently running a VBA script in excel to allow for specific username and password access to specific sheets. I was following this tutorial on youtube and everything seemed to be going well until I began encountering errors.
I am getting a Type mismatch error in my code, which is below. There are two lines that are giving me errors, they are commented, any help would be greatly appreciated!
Option Explicit
Sub CheckUser()
Dim UserRow, SheetCol As Long
Dim SheetNm As String
With Sheet34
.Calculate
If .Range("B6").Value = Empty Then 'Incorrect Username
MsgBox "Please enter a correct username"
Exit Sub
End If
If .Range("B5").Value <> True Then 'Incorrect Password
MsgBox "Please enter a correct password"
Exit Sub
End If
UserForm1.Hide
UserRow = .Range("b6").Value 'userrow
.Range("B3").Value = ""
.Range("b4").Value = ""
For SheetCol = 6 To 26
SheetNm = .Cells(2, SheetCol).Value 'SheetName
If .Cells(UserRow, SheetCol).Value = "Ð" Then ' line where error occurs
Sheets(SheetNm).Protect "TEP2003"
Sheets(SheetNm).Visible = xlSheetVisible
End If
If .Cells(UserRow, SheetCol).Value = "Ï" Then ' line where error occurs
Sheets(SheetNm).Visible = xlVeryHidden
End If
Next SheetCol
End With
End Sub
Sub closeworkbook()
Sheet1.Activate
Dim WkSht As Worksheet
For Each WkSht In ThisWorkbook.Worksheets
If WkSht.Name <> "Main" Then WkSht.Visible = xlSheetVeryHidden
Next WkSht
ThisWorkbook.Save
End Sub
Use the Range.Text property. Range.Text will not fix a worksheet error code but it will evaluate one as text where Range.Value will fail. Combine the two with an ElseIf; there is no point in evaluating the second if the first passes.
...
If .Cells(UserRow, SheetCol).Text = "Ð" Then
...
ElseIf .Cells(UserRow, SheetCol).Text = "I" Then
...
End If
is there I way for searching a value on the next sheet (ActiveSheet.Next.Activate) without jumping on to it?
Here the whole Code:
the problem is, it jumps to the next sheet even if there is no searched value.
Dim ws As Worksheet
Dim Loc As Range
Dim StrVal As String
Dim StrRep As String
Dim i As Integer
Private Sub CommandButton1_Click()
i = 1
Call Replacing
End Sub
Private Sub CommandButton2_Click()
i = 2
Call Replacing
End Sub
Public Sub Replacing()
StrVal = Userform1.Textbox1.Text
StrRep = Me.Textbox1.Text
if Trim(StrVal) = "" Then Exit Sub
Dim fstAddress As String
Dim nxtAddress As String
For Each ws In ThisWorkbook.Worksheets
With ws
Set Loc = .Cells.Find(what:=StrVal)
fstAddress = Loc.Address
If Not Loc Is Nothing Then
If Not StrRep = "" And i = 1 Then
Loc.Value = StrRep
Set Loc = .Cells.FindNext(Loc)
ElseIf i = 2 Then Set Loc = Range(ActiveCell.Address)
Set Loc = .Cells.FindNext(Loc)
nxtAddress = Loc.Address
If Loc.Address = fstAddress Then
ActiveSheet.Next.Activate '****Here it should jump only if found something on the next sheet****
GoTo repeat
nxtAddress = Loc.Address
End If
If Not Loc Is Nothing Then Application.Goto ws.Range(nxtAddress), False
End If
i = 0
End If
End With
Set Loc = Nothing
repeat:
Next ws
End Sub
the variable "i" which switches between the values 0, 1 and 2 is bound to two buttons. these buttons are "Replace" and "Skip (to next found value)".
This code asks on each occurrence of StrVal whether you want to replace the value or skip it.
I found a problem checking if Found_Address = First_Found_Address:
If you've replaced the value in in First_Found_Address it won't find that address again and miss the starting point in the loop.
Also the original source of the code stops at the last value using Loop While Not c Is Nothing And c.Address <> firstAddress. The problem here is that if the value in c is being changed eventually c will be Nothing but it will still try and check the address of c - causing an error (Range Find Method).
My solution to this is to build up a string of visited addresses on the sheet and checking if the current address has already been visited using INSTR.
I've included the code for calling from a button click or from within another procedure.
Private Sub CommandButton1_Click()
FindReplace Userform1.Textbox1.Text, 1
End Sub
Private Sub CommandButton2_Click()
FindReplace Userform1.Textbox1.Text, 1, Me.Textbox1.Text
End Sub
Sub Test()
FindReplace "cd", 1, "ab"
End Sub
Sub FindReplace(StrVal As String, i As Long, Optional StrRep As String = "")
Dim ws As Worksheet
Dim Loc As Range
Dim fstAddress As String
Dim bDecision As Variant
For Each ws In ThisWorkbook.Worksheets
'Reset the visited address list on each sheet.
fstAddress = ""
With ws
Set Loc = .Cells.Find(what:=StrVal, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
If Not Loc Is Nothing Then
Do
fstAddress = fstAddress & "|" & Loc.Address
Loc.Parent.Activate 'Activate the correct sheet.
Loc.Activate 'and then the cell on the sheet.
bDecision = MsgBox("Replace value?", vbYesNo + vbQuestion, "Replace or Select value?")
If bDecision = vbYes Then
Loc = StrRep 'Raise the blade, make the change.
'Re-arrange it 'til it's sane.
End If
Set Loc = .Cells.FindNext(Loc)
If Loc Is Nothing Then Exit Do
Loop While InStr(fstAddress, Loc.Address) = 0
End If
End With
Next ws
End Sub
Here is part of the code I am working on which is a part of a macro.
This is also the same on another file which is basically the same also.
The macro works on the other file while on the other, it doesn't and comes with the Run-time error '91'.
Attached is the code:
shtData.Activate
Dim r As Integer
Dim strassured As String
r = 1
While ActiveSheet.Cells(r, 1) <> ""
ActiveSheet.Cells(r, 1).Select
strassured = ActiveCell.Value
If shtWorkSpace.Range("B3").Value = strassured Then
If shtWorkSpace.Range("A60").Value = "Pending" Then
DataHandling.OverwriteDataTab (strassured)
Exit Sub
Else
MsgBox "This assured name is already in the database. Assured Names must be unique!", vbCritical
shtWorkSpace.Activate
ActiveSheet.Range("A1").Select
Exit Sub
End If
Else
r = r + 1
End If
Wend
I've added an answer, not to provide how to define and Set both worksheets (shtData and shtWorkSpace).
But also to provide a better coding practice, there is no need to Activate worksheets, or use Select and ActiveCell. Instead use fully qualified Ranges and Worksheets.
Code
Sub Test()
Dim shtData As Worksheet
Dim shtWorkSpace As Worksheet
Dim r As Integer
Dim strassured As String
Set shtData = Worksheets("Data") '<-- modify "Data" to your sheet name
Set shtWorkSpace = Worksheets("Workspace") '<-- modify "Workspace" to your sheet name
r = 1
While shtData.Cells(r, 1) <> ""
strassured = shtData.Cells(r, 1).Value
If shtWorkSpace.Range("B3").Value = strassured Then
If shtWorkSpace.Range("A60").Value = "Pending" Then
DataHandling.OverwriteDataTab (strassured)
Exit Sub
Else
MsgBox "This assured name is already in the database. Assured Names must be unique!", vbCritical
shtWorkSpace.Activate
ActiveSheet.Range("A1").Select '<-- not sure why you need to select the sheet and Range("A1")
Exit Sub
End If
Else
r = r + 1
End If
Wend
End Sub
I want to write a macro that will pick a particular value (in my case, stored in cell A1) from a dropdown list (in my case, in cell D6).
Here's what I have so far:
sr_par2 = Array ("TEXT", 'TEXT2", "TEXT3")
sr = Range("A1").Value
(...)
Dim i As Integer
i = 0
Range("D6").Select
Do While (sr <> ActiveCell.FormulaR1C1)
Range("D6").Select
ActiveCell.FormulaR1C1 = sr_par2(i)
i = i + 1
Loop
Is this what you are trying? I have commented the code so that you will not have a problem understanding it. Still if you do then simply ask :)
Sub Sample()
Dim ws As Worksheet
Dim rngIn As Range, rngOut As Range
Dim MyAr
Dim sFormula As String
Dim i As Long
'~~> Replace this with the relevant worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> Set your input and output range here
Set rngIn = .Range("A1")
Set rngOut = .Range("D6")
'~~> Get the validation list if there is one
On Error Resume Next
sFormula = rngOut.Validation.Formula1
On Error GoTo 0
If sFormula = "" Then
'~~> If no validation list then directly populate the value
rngOut.Value = rngIn.Value
Else
'validation list TEXT1,TEXT2,TEXT3
MyAr = Split(sFormula, ",")
'~~> Loop through the list and compare
For i = LBound(MyAr) To UBound(MyAr)
If UCase(Trim(rngIn.Value)) = UCase(Trim(MyAr(i))) Then
rngOut.Value = MyAr(i)
Exit For
End If
Next i
'~~> Check if the cell is still blank. If it is then it means that
'~~> Cell A1 has a value which is not part of the list
If Len(Trim(rngOut.Value)) = 0 Then
MsgBox "The value in " & rngOut.Address & _
" cannot be set as the value you are copying is not part of the list"
End If
End If
End With
End Sub
If I understood correctly, this should do what you want :
sr_par2 = Array("TEXT", "TEXT2", "TEXT3")
sr = Range("A1").Value
Dim i As Integer
i = 0
On Error GoTo Handler
Do While (sr <> sr_par2(i))
i = i + 1
Loop
Range("D6").FormulaR1C1 = sr_par2(i)
Exit Sub
Handler:
MsgBox "Value not in the list", vbCritical + vbOKOnly, "Value not found"
new to VBA here. I've been stuck on this problem for a while now:
Essentially, I need to create a macro that copies over specific data from one sheet to another, that is up to the user to specify. The catch is that while all the data is in one column (B), not all rows of the column have relevant entries; some are blank and some have other data that I don't want.
Only entries that begin with 4 numbers are wanted. I can't seem to get how the iterated copy-pasting works; what I've come up with is as follows:
'defining input
Dim dater As Date
dater = Range("B2")
If dater = False Then
MsgBox "Date not specified"
Exit Sub
End If
Dim sheetin As String
sheetin = Range("B5")
If sheetin = "" Then
MsgBox "Input Sheet not specified"
Exit Sub
End If
Dim wbin As String
wbin = Range("B4")
If wbin = "" Then
MsgBox "Input workbook not specified"
Exit Sub
End If
Dim sheetout As String
sheetout = Range("B9")
If sheetout = "" Then
MsgBox "Output Sheet not specified"
Exit Sub
End If
Dim wbout As String
wbout = Range("B8")
If wbout = "" Then
MsgBox "Output Workbook not specified"
Exit Sub
End If
Windows(wbout).Activate
Dim sh As Worksheet, existx As Boolean
For Each sh In Worksheets
If sh.Name Like sheetout Then existx = True: Exit For
Next
If existx = True Then
If Sheets(sheetout).Visible = False Then Sheets(sheetout).Visible = True
Else
Sheets.Add.Name = CStr(sheetout)
End If
'copy pasting values
Windows(wbin).Activate
Sheets(sheetin).Select
'specify maximum row
iMaxRow = 500
For iRow = 1 To iMaxRow
With Worksheets(sheetin).Cells(iRow, 2)
'Check that cell is not empty.
If .Value = "####*" Then
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
'Else do nothing.
End If
End With
Next iRow
End Sub
Subsequently i'll have to match data to these entries that have been copied over but I figure once i get the hang of how to do iterated stuff it shouldn't be too much of a problem. But right now i'm really stuck... Please help!
It looks like it should work, except for that part :
With Worksheets(sheetin).Cells(iRow, 2)
If .Value = "####*" Then
.Copy Destination:=Workbooks(wbout).Worksheets(sheetout).Range("A" & i)
End If
End With
The third line contains an unknown variable : i.
You need to define it to contain the number of the line to which you're copying. For example, if you want to copy to the first available line, try this :
Set wsOut = Workbooks(wbout).Worksheets(sheetout)
With Worksheets(sheetin).Cells(iRow, 2)
If .Value = "####*" Then
i = wsOut.Cells(wsOut.Rows.Count, 1).End(xlUp).Row + 1
.Copy Destination:=wsOut.Range("A" & i)
End If
End With