The idea is I want to evaluate each Ws in Workbook for a given criteria in vba. If the criteria is met I want it to do something. If it's not met I want to go to the next ws. I know this is simple stuff. Any help would be really appreciate
Here's what I have so far.
Sub dataconsol()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
If ActiveSheet.Range("B9").Value = 1 Then
Range("A1").Value = 2
ElseIf Range("b9").Value <> 1 Then
End If
Next Ws
End Sub
Your code is fine. Switch ActiveSheet to With Ws as in your case ActiveSheet was always 'Sheet1'.
Sub dataconsol()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
With Ws
If .Range("B9").Value = 1 Then
.Range("A1").Value = 2
ElseIf .Range("b9").Value <> 1 Then
End If
End With
Next Ws
End Sub
Or if you want to use ActiveSheet:
Sub dataconsol2()
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
Ws.Activate
If Range("B9").Value = 1 Then
Range("A1").Value = 2
ElseIf Range("b9").Value <> 1 Then
End If
Next Ws
End Sub
Related
my code runs by copying a specific range of data from multiple sheets that are available on the workbook. But I want to skip a sheet called "Data Recap" so that the code only runs for the other sheets only
what should I add to my code?
Sub Copy_Data()
Dim ws As Worksheet, MasterSheet As Worksheet
Dim originalDestinationCell As Range, nextDestCell As Range
Dim firstGreyCell As Range, c As Range, e As Range, s As Range
Dim lastRow As Long, firstRow As Long, colToCheckLast As Long, i As Long
Dim isMain As Boolean
Set MasterSheet = Sheets("Form Rekap") 'where you want to put the copied data
Set originalDestinationCell = MasterSheet.Range("C6") 'the first cell the data will be copied to
Set nextDestCell = originalDestinationCell.Offset(-1, 0)
firstRow = 6
colToCheckLast = 7
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = MasterSheet.Name Then
Set firstGreyCell = ws.Range("C" & firstRow) 'Set first starting loop cell
lastRow = ws.Cells(ws.Rows.Count, colToCheckLast).End(xlUp).Row
isMain = True
For i = firstRow To lastRow
Set c = ws.Range("C" & i)
Set e = ws.Range("E" & i)
Set s = Nothing
If isMain Then
If c.Interior.Color = firstGreyCell.Interior.Color Then
If Not IsEmpty(c) Then
Set s = c
Else
isMain = False
End If
End If
Else
If c.Interior.Color = firstGreyCell.Interior.Color Then
If Not IsEmpty(c) Then
Set s = c
End If
isMain = True
Else
If Not IsEmpty(e) Then
Set s = e
End If
End If
End If
If Not s Is Nothing Then
Set nextDestCell = MasterSheet.Cells(nextDestCell.Row + 1, originalDestinationCell.Column)
nextDestCell.Interior.Color = s.Interior.Color
nextDestCell.Value = s.Value
End If
Next
End If
Next ws
End Sub
Few ways to do what you want:
Sub SkipSpecificWorksheet()
Dim ws As Worksheet
'Your version
For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = MasterSheet.Name And Not ws.Name = "Data Recap" Then 'Add another condition
'Do stuffs to the worksheet
End If
Next ws
'Alternative
'Same logic as above, just different syntax
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> MasterSheet.Name And ws.Name <> "Data Recap" Then
'Do stuffs to the worksheet
End If
Next ws
'Another alternative using Select Statement
For Each ws In ThisWorkbook.Worksheets
Select Case ws.Name
Case MasterSheet.Name, "Data Recap" 'List of worksheet to skip
Case Else
'Do stuffs to the worksheet
End Select
Next ws
End Sub
Process Worksheets With Exceptions
Option Explicit
Sub ProcessWorksheets()
Const ExceptionsList As String = "Form Recap,Data Recap"
Dim Exceptions() As String: Exceptions = Split(ExceptionsList, ",")
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If IsError(Application.Match(ws.Name, Exceptions, 0)) Then
' e.g.:
Debug.Print ws.Name
'Else ' is in the list; do nothing
End If
Next ws
End Sub
I have the below macro which lists all the worksheet names in the current(host) workbook.
I would like to adapt this code so it targets an active/open workbook, which has its workbook name & extension referenced in cell C1.
range("C1").value
Please can someone let me know how I adapt the below code.
Sub ListSheets()
Dim ws As Worksheet
Dim x As Integer
x = 1
Sheets("Sheet1").Range("A:A").Clear
For Each ws In Worksheets
Sheets("Sheet1").Cells(x, 1) = ws.Name
x = x + 1
Next ws
End Sub
This should do the job but you don't need the extension of the workbook just the name.
Sub ListSheets()
Dim ws As Worksheet
Dim x As Integer
Dim wbk As Workbook
Dim wbkName As String
x = 1
wbkName = ThisWorkbook.Sheets("Sheet1").Range("C1").Value
ThisWorkbook.Sheets("Sheet1").Range("A:A").Clear
Set wbk = Application.Workbooks(wbkName)
For Each ws In wbk.Worksheets
ThisWorkbook.Sheets("Sheet1").Cells(x, 1) = ws.Name
x = x + 1
Next ws
End Sub
Sub ListSheets()
Dim inputwb As Workbook
Dim ws As Worksheet, source As Worksheet
Dim LRow As Long
' Change source sheet if it is NOT always the active worksheet
' or activate the source sheet first with Workbooks("NAME").Sheets(INDEX).Activate (not preferable)
Set source = ActiveSheet
On Error Resume Next
Set inputwb = Workbooks(Cells(1, 1).Value)
If err.Number <> 0 Then
MsgBox "Could not find workbook " & Cells(1, 1).Value & ". Subroutine execution stopped."
Exit Sub
End If
On Error GoTo 0
ThisWorkbook.Sheets("Sheet1").Range("A:A").Clear
LRow = 1
For Each ws In inputwb.Worksheets
ThisWorkbook.Sheets("Sheet1").Cells(LRow, 1) = ws.Name
LRow = LRow + 1
Next ws
End Sub
I'm trying to define cell values for a column and repeat this for each worksheet in the current workbook. Here is my code for testing a simple example. It only works for the current active worksheet, while not the other worksheets. What's the problem in the code?
Sub test()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
Range("F2").Value = "1"
Range("F3").Value = "2"
Range("F2:F3").Select
Selection.AutoFill Destination:=Range("F2:F21"), Type:=xlFillDefault
End With
Next ws
End Sub
Thanks in advance!
You need some '.' with With
Sub test()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
.Range("F2").Value = "1"
.Range("F3").Value = "2"
.Range("F2:F3").AutoFill Destination:=.Range("F2:F21"), Type:=xlFillDefault
End With
Next ws
End Sub
I am looking for a way with VBA in excel to loop through spreadsheet. I found a lot of sites with recommendations on using a range function, but nothing specific enough that has solve the issues that I have. Macro will only work on current tab. It will not loop through.
Sub UpdateAll()
'
' UpdateAll Macro
'
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call Update_OI
Next ws
End Sub
Sub Update_OI()
'
' Update_OI Macro
Dim rng As Range
For Colx = 3 To 81
Cells(10, Colx).Select
If ActiveCell.Offset(-8, 0) = "X" Then GoTo 4
If ActiveCell.Offset(-3, 0) = 0 Then GoTo 4
If ActiveCell.Value = vbNullString Then GoTo 4
If ActiveCell.Value <> vbNullString Then GoTo 1
1
goalvalue = Cells(70, Colx).Value
Range(Cells(69, Colx), Cells(69, Colx)).GoalSeek Goal:=goalvalue, ChangingCell:=Range(Cells(10, Colx), Cells(10, Colx))
4
Next Colx
End Sub
You can pass the sheet object to Update_OI, and try not to use Select/Activate - you can almost always avoid that, and doing so will make your code more robust.
Sub UpdateAll()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Update_OI ws
Next ws
End Sub
Sub Update_OI(ws as Worksheet)
Dim rng As Range, Colx As Long
For Colx = 3 To 81
Set rng = ws.Cells(10, Colx)
If rng.Offset(-8, 0).Value <> "X" And _
rng.Offset(-3, 0).Value <> 0 And _
Len(rng.Value) > 0 Then
goalvalue = ws.Cells(70, Colx).Value
ws.Cells(69, Colx).GoalSeek Goal:=goalvalue, _
ChangingCell:=ws.Cells(10, Colx)
End If
Next Colx
End Sub
Change your update all as below. It should work now.
Sub UpdateAll()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Select
Call Update_OI
Next ws
End Sub
Below code works
Public Sub main()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Cells(1, 2).Value = 11111
Next ws
End Sub
Try changing
Dim ws As Worksheet For Each ws In ActiveWorkbook.Worksheets
Call Update_OI
Next ws
To
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
Call Update_OI
Next ws
Or was it just copy paste formating problem. In this case I will remove my answer as it si no answer :).
Can some one help with a vba code to copy a range from multiple worksheets (52 weeks) into a summary sheet in the same workbook. Range is the same in each worksheet. I want the data to be copied and pasted in 52 columns in the ssummary worksheet, from week1 to week 52.
I have found this code online:
Sub SummurizeSheets()
Dim ws As Worksheet
Application.ScreenUpdating = False
Sheets("Summary").Activate
For Each ws In Worksheets
If ws.Name <> "Summary" Then
ws.Range("F46:O47").Copy
Worksheets("Summary").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
End If
Next ws
End Sub
Try below code .Also set Application.ScreenUpdating = True.
Sub SummurizeSheets()
Dim ws As Worksheet
Dim j As Integer, col As Integer
Application.ScreenUpdating = False
Sheets("Summary").Activate
For Each ws In Worksheets
If ws.Name <> "Summary" Then
ws.Range("k3:k373").Copy
col = Worksheets("Summary").Range("IV1").End(xlToLeft).Column + 1
Worksheets("Summary").Cells(1, col).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Next ws
Columns(1).Delete
Range("A1").Activate
Application.ScreenUpdating = True
End Sub