I am trying to create a consolidated list of highlighted cells that are on different tabs in my workbook. As I understand VBA is my best option.
Logic would be something like:
Loop through all tabs and
If cell = color index 4 then
copy value and paste into a tab called 'highlightedcells'
Im as far as this currently
sub findhighlights
For Each ws In ActiveWorkbook.Worksheets
For Each Cell In ws.UsedRange.Cells
If Cell.Interior.ColorIndex = 4 Then
cell.value.copy
Any help would be welcomed.
Try this out:
Sub findhighlights()
Dim wb As Workbook, ws As Worksheet, c As Range, wsList As Worksheet
Set wb = ActiveWorkbook 'always use a specific workbook
Set wsList = wb.Worksheets("Listing") 'listing goes here
For Each ws In wb.Worksheets 'loop sheets
If ws.Name <> wsList.Name Then 'skip the "Listing" sheet
For Each c In ws.UsedRange.Cells
If c.Interior.ColorIndex = 4 Then
'list info for this cell
With wsList.Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Resize(1, 3).Value = Array(ws.Name, c.Address, c.Value)
End With
End If
Next c
End If 'is not the Listing sheet
Next ws
End Sub
Related
I have a 52 sheet workbook that needs to be reset after the file is saved as a copy.
I have the UnHide part figured out, but I can't seem to figure out the Clearcontents.
On many Worksheets, not all, in row A there is a string "State Requires All License Verifications"
It is in a variable row, between 6 and 12. Starting with ws2 I want to find the string and clear the rows below it. Column range A:H
Then Check the next worksheet.
I have this so far..
Sub UnhideAllSheets()
Dim ws As Worksheet
Dim rowNum As Long
Dim stateReg As String
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
If ws.Visible Then
'Activate sheet
ws.Activate
'Look for String "State Requires All License Verifications"
Set stateReq = .Find(what:="State Requires All License Verifications")
'Null find quits loop
If Not stateReq Is Nothing Then
rowNum = stateReq.Row
End If
'Clear all Used rows after String(stateReq)
With Sheets(ws)
Intersect(.Range(.Rows(rowNum + 1), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("A:H")).ClearContents
End With
'Select and Zoom to A1 upon leaving the worksheet
Range("A1").Select
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
End If
Next ws
'Jump back to the first worksheet "Information"
Sheets("Information").Select
Range("E2").Select
End Sub
Try this. Not sure where you got stuck.
I have assumed the string is in column A and that A is also a reliable indicator of the last used row (so may need changing).
Also no need to activate the sheet.
Sub UnhideAllSheets()
Dim ws As Worksheet
Dim rowNum As Long
Dim stateReg As Range
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Set stateReg = ws.Columns(1).Find(what:="State Requires All License Verifications", Lookat:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not stateReg Is Nothing Then
Range(stateReg.Offset(1), ws.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).ClearContents
End If
Next ws
'Jump back to the first worksheet "Information"
Application.Goto Sheets("Information").Range("E2")
End Sub
Maybe something like:
Sub Fresh_Slate()
Dim ws As Worksheet
Dim Found As Range
Dim Target As String
Dim lr As Long
Target = "State Requires All License Verifications"
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "Sheet1" Then 'You can add sheets to ignore here
ws.Visible = xlSheetVisible
Set Found = ws.Cells.Find(Target)
If Not Found Is Nothing Then
'Assuming Column A on each sheet is a good indicator of the last used row in range
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range(ws.Cells(Found.Row + 1, 1), ws.Cells(lr, 8)).ClearContents
End If
Set Found = Nothing
End If
Next ws
End Sub
I have a column in sheet 1 containing different values. I'd like to loop thru the column and create new sheets with the sheet name corresponding to the values. Each time I create a sheet, I like to set the new sheet active and do some task on that sheet.
Sub test()
i = 4 'starting row in sheet 1
While Not IsEmpty(Cells(i, 1))
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add
ws.Name = Cells(i, 1).Value
'do something to new sheet
i = i + 1
Wend
End Sub
This does not work and the examples I've found online are way too complex for my need. I hope for an easy solution pointing out what I did wrong. thanks
This adds worksheets and names them as per the values in A4 downwards:
Dim wks As Worksheet
Dim wksNew As Worksheet
Dim rngCell As Range
Set wks = Sheets("Sheet1")
Set rngCell = wks.Range("A4")
While Not IsEmpty(rngCell)
Set wksNew = ActiveWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
wksNew.Name = rngCell.Value
'do stuff with wksNew
Set rngCell = rngCell.Offset(1)
Wend
In the code below, we can put Sheet1 - Sheet4 in selection mode and copy.
But the point here is that the number of Sheets varies. Each time the file is changed, the number of Sheets is low or high. I just want to copy Sheet1 .... n, not all Sheets. (Every Sheet with the name of the "Sheet".
How can this code be corrected for this issue?
Worksheets(Array("Sheet1", "Sheet2", "Sheet4")).Copy
Sub m()
Dim nSht As Long
ReDim shts(1 To Worksheets.Count) As String
Dim sht As Worksheet
For Each sht In Worksheets
If sht.Name Like "Sheet*" Then
nSht = nSht + 1
shts(nSht) = sht.Name
End If
Next
If nSht > 0 Then
ReDim Preserve shts(1 To nSht)
Worksheets(shts).Copy
End If
just for the record, here's the first solution spoiling
Dim sht As Worksheet
For Each sht In Worksheets
If sht.Name Like "Sheet*" Then
If Not ActiveSheet.Name Like "Sheet*" Then sht.Activate
sht.Select False
End If
Next
ThisWorkbook.Windows(1).SelectedSheets.Copy
I have three separate worksheets in a workbook that contain thousands of rows of information and new information is added frequently. I would like to be able to create separate reports using macros and VBA to print onto another worksheet when I need the report.
For example, report one would include all completed jobs in 2014. If Completed? equals YES and Year equals 2014, print entire row on blank worksheet. However, I need to use VBA so it goes through three worksheets and prints them all together in a separate worksheet. How would I do this?
Clarification: Basically if these two cells equal this and this, print the row on a different sheet.
Practice with this.
Insert a button or some other type of object on the sheet with the data.
Once clicked the code will delete all the sheets except the active sheet.
It then loops through column A and creates the sheets.
Then it loops through the sheets and filters your data sheet, copies and pastes the data into the sheet and moves on to the next sheet.
Sub getSht()
Dim c As Range, sh As Worksheet
Dim Rws As Long, Rng As Range, fRng As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Application.DisplayAlerts = 0
Application.ScreenUpdating = 0
For Each sh In Sheets
If sh.Name <> ws.Name Then sh.Delete
Next sh
With ws
Rws = .Cells(Rows.Count, "A").End(xlUp).Row
Set Rng = .Range(.Cells(2, 1), .Cells(Rws, 1))
For Each c In Rng.Cells
If WorksheetExists(c.Value) Then
Else: Sheets.Add.Name = c
End If
Next c
End With
For Each sh In Sheets
If sh.Name <> ws.Name Then
ws.Range("A:A").AutoFilter Field:=1, Criteria1:=sh.Name
Set fRng = ws.Range(ws.Cells(1, "A"), ws.Cells(Rws, "D"))
fRng.Copy Destination:=sh.Range("A1")
End If
ws.AutoFilterMode = 0
Next sh
ws.Activate
End Sub
Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function
I have a macro that hides rows based on cell values. I am attempting to use this across multiple sheets in the workbook, but not all of them. My code below seems to run the macro multiple times in the same sheet.
Sub HideRowsWbk()
Dim LastRow As Long
Dim Rng As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
With ThisWorkbook
For Each ws In .Worksheets
Select Case ws.Name
Case "0000_Index", "000_BidItems", "000_EntrySheet", "000_PayReqs"
'do nothing - exclude these sheets
Case Else
With ws
LastRow = Range("A65536").End(xlUp).Row '
Set Rng = Range("M15:M" & LastRow) 'choose column where value exists
For Each cell In Rng
If cell.Value = "0" Or cell.Value = "-" Then 'checks if cell value is 0 or -
cell.EntireRow.Hidden = True
End If
Next cell
End With
End Select
Next ws
End With
Application.ScreenUpdating = True
End Sub
Please tell me what I have done wrong and how I can fix this. Also please show me how I can improve my minimal coding skills. I am using Excel 2007.
Thank you.
use:
LastRow = .Range("A65536").End(xlUp).Row '
Set Rng = .Range("M15:M" & LastRow) 'choose column where value exists
the "." makes it work with ws