I'm trying to delete rows in one sheet that match criteria from rows taken from multiple other worksheets. I need to cycle through all the other worksheets in my workbook, and each time I find something that matches, I delete the entire row in the first sheet. I'm getting Error 1004 on Union. I thought this might be caused because you can't use Union across sheets, so I set it to Nothing after each sheet. I'm still getting the same error.
Here's the code:
Sub findRemaining()
Dim rngToDel As Range
Dim fRng As Range 'Fund range
Dim wCell As Range 'Working sheet cell
Dim wRng As Range 'Working sheet range
Dim WS_Count As Integer
Dim I As Integer
Set fRng = Worksheets("All").Range("B2:B1495")
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 2 To WS_Count
Set rngToDel = Nothing
Set wRng = Worksheets(I).Range("B2:B200")
For Each wCell In wRng 'Loop through all working cells
' if wCell found in Fund range then delete row
If Not IsError(Application.Match(Trim(wCell.Value), fRng, 0)) Then
If rngToDel Is Nothing Then
Set rngToDel = wCell
Else
Set rngToDel = Union(rngToDel, wCell)
End If
End If
Next wCell
If Not rngToDel Is Nothing Then rngToDel.EntireRow.Delete
Next I
End Sub
The problem was I set range to delete as wCell in wRng, but really what I wanted to delete was cells in fRng. By fixing that the rest of the code worked perfectly. (thanks chris)
Related
I am a new VBA user, and wanting to copy data from a table in Word into Excel.
With support of lovely online folk, I have managed to get the following which seems to work:
Sub extractData()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet
Dim Tbls As Word.Tables, r As Variant, cell As Variant
wd.Visible = True
Set doc = wd.Documents.Open("\\file.docx", ReadOnly:=True)
Set Tbls = doc.Tables
Set sh = ActiveSheet
For Each r In Tbls(1).Rows
For Each cell In r.Cells
sh.Cells(cell.Row.Index, cell.Column.Index).Value = Application.WorksheetFunction.Clean(cell.Range.Text)
Next cell
Next r
End Sub
However, the table in Word has horizontal cell merging, and VBA can't work with mixed cell widths. I do not need these rows to be copied, so is there a way to count how many columns (should be 6), and if less than 6 to then skip the row?
I have tried looking online, but cannot find how to get it to count the cells in each row, and then skip if less than 6. I feel like it should be pretty straightforward, but I'm very new to this!
Any suggestions?
Thanks!
a) I am surprised that you state that "VBA can't work with mixed cell widths" - I did a test and your code should work without issues on tables where you have (horizontally) merged cells. There is a problem with the code when you have vertically merged cells because in that case you cannot access the individual rows of the table
b) if you want to loop over all cells of a table no matter if it has merged cells or not, you can loop over all cells of the Range of the table:
Dim rng As Word.Range
Dim tbl As Word.Table
Set tbl = doc.Tables(1)
Set rng = tbl.Range
For Each cell In rng.Cells
Debug.Print cell.RowIndex, cell.ColumnIndex, cell.Range.Text
Next
The properties RowIndex and ColumnIndex give you the row resp. column number of the cell - if it is a merged cell, it's the first (top left) cell.
c) To get the number of cells in a row or column, you can use the cells.Count property. As mentioned, this will work for rows only if there are no vertically merged cells, similarly, it will for columns only if there are no horizontally merged cells.
Dim row As Word.row, col As Word.Column
For Each r In tbl.Rows
r.Cells.Count
Next r
Dim c As Word.Column
For Each c In Tbls(1).Columns
c.Cells.Count
Next
A row has a collection of cells, and collections always have a Count property.
Sub extractData()
Dim wd As New Word.Application
Dim doc As Word.Document
Dim sh As Worksheet
Dim Tbls As Word.Tables, r As Word.Row, cell As Word.Cell
wd.Visible = True
Set doc = wd.Documents.Open("\\file.docx", ReadOnly:=True)
Set Tbls = doc.Tables
Set sh = ActiveSheet
For Each r In Tbls(1).Rows
If r.Cells.Count = 6 Then
For Each cell In r.Cells
sh.Cells(cell.Row.Index, cell.Column.Index).Value = Application.WorksheetFunction.Clean(cell.Range.Text)
Next cell
End if
Next r
End Sub
I would need to open a random selected link from a cell to a website in my list. My internet links are put in column B, but I cannot get it to open the hyperlink after it has selected a cell from my list.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets("Sheet1")
With Sh
Set Rng = .Range("C1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
End With
For Each Cell In Rng
ThisWorkbook.FollowHyperlink Cell.Value
Next Cell
End Sub
Just to be sure I got it right:
The addresses are stored in column B (in your code you're using column C)
You don't want to open all of the addresses, but only one random one?
The addresses are full URLs? (Like "https://stackoverflow.com/")
I tidied up your code a little bit. Read the comments, to understand what is happening.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets(1)
' Get a Range object of all possible addresses
Set Rng = Intersect(Sh.UsedRange, Sh.Range("B:B"))
' Open one random element of them
ThisWorkbook.FollowHyperlink Rng(Int(Rnd * Rng.Count) + 1)
End Sub
I feel like this is too simple to be stuck on, but I have a workbook with about 100 sheets, and I need to copy a range from one sheet (Sheet2 Range a1:H200) to Sheet5 AF1:AM200 and every sheet after (Sheet5 through Sheet100 or more). I have tried creating a loop and copying the original range and pasting to each sheet, but it hasn't worked. I feel like this is the closest I've gotten
Sub CopyPasteLoop()
Dim wsVar As Worksheet
For Each wsVar In ThisWorkbook.Sheets
With wsVar
ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value = ThisWorkbook.Worksheets("Sheet5").Range("AF1").Value
End With
Next wsVar
End Sub
I feel like it should be simpler, but I can't make it work. Thanks!
Almost there. Try this:
Sub CopyPasteLoop()
Dim wsVar As Worksheet
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = ThisWorkbook.Worksheets("Sheet2").Range("A1:H200").Value
Next i
End Sub
Or for better performance, use this:
Dim vRange as Variant
vRange = ThisWorkbook.Worksheets(2).range("A1:H200")
Dim i as Integer
For i = 5 to ThisWorkbook.Worksheets.Count
ThisWorkbook.Worksheets(i).Range("AF1:AM200").Value = vRange
Next i
Hopefully #Scott Holtzman's answer will work for you (providing your sheets are indexed in the same order as they're named). This approach will also work.
Dim wb As Workbook, ws As Worksheet
Dim rng As Range
Set wb = ThisWorkbook
Set rng = wb.Sheets("Sheet2").Range("A1:H200")
For Each ws In wb.Sheets
If CInt(Right(ws.Name, Len(ws.Name) - Len("Sheet"))) >= 5 Then
ws.Range("AF1:AM200").Value = rng.Value
End If
Next ws
Yesterday I decided to learn some VBA to make my excel time easier. It has been going better then expected, but I have been breaking my teeth on this code for many hours now.
I am trying to remove all empty (except title) columns, and this in all sheets of a workbook.
After lots of googling I managed to find some examples i could adapt to my needs.
I used this code: remove columns
and then tried to loop it through the sheets by using dear old microsoft support
Together i frankensteined it into this:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim MyRange As Range
Dim iCounter As Long
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
'removecode
' Define the target Range.
Set MyRange = ActiveWorkbook.Worksheets(I).UsedRange
'Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'If entire column is empty then delete it.
If Application.CountA(Columns(iCounter).EntireColumn) = 1 Then
Columns(iCounter).Delete
End If
Next iCounter
'endremovecode
MsgBox ActiveWorkbook.Worksheets(I).Name
Next I
End Sub
When I run this, only the the starting worksheet is cleaned up. The messagebox does loop through all of them.
Why? What am I doing wrong?
I tried finding a solution, but non of the topics here seemed to give more clarity.
Thank a bunch for leading me in the right direction.
Lara
Columns(iCounter).EntireColumn
and
Columns(iCounter).Delete
are not prefixed with MyRange so refer to the active sheet's columns not the sheet containing MyRange. Stick MyRange. infront of them.
You're almost there. You just need to qualify your application.counta and also your .columns().delete. so each is working directly with the sheet in question. Otherwise it's just working with the active sheet.
Try this:
Sub WorksheetLoop()
Dim WS_Count As Integer
Dim I As Integer
Dim MyRange As Range
Dim iCounter As Long
Dim ws As Worksheet
WS_Count = ActiveWorkbook.Worksheets.Count
For I = 1 To WS_Count
Set ws = ActiveWorkbook.Worksheets(I)
'removecode
With ws
' Define the target Range.
Set MyRange = .UsedRange
'Start reverse looping through the range.
For iCounter = MyRange.Columns.Count To 1 Step -1
'If entire column is empty then delete it.
If Application.CountA(.Columns(iCounter).EntireColumn) = 0 Then
.Columns(iCounter).Delete
End If
Next iCounter
End With
'endremovecode
MsgBox ws.Name
Next I
End Sub
I have several VBA routines in an Excel 2007. There is a template worksheet which gets copied (and accordingly altered) up to 50 times. Now, this template contains a range called "HideRows", so this range gets copied several times in all those new worksheets. I want to hide all rows that contain the value 0 in the range "HideRows". Not all rows shall be hidden, only those rows that contain the value 0. This is what I've got so far:
Option Explicit
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each rngName In ActiveWorkbook.Names
If rngName.Name = "HideRows" Then
With cell
For Each cell In rngName
If .Value = 0 Then
.EntireRow.Hidden = True
End If
Next cell
End With
End If
Next rngName
What's wrong here and what do I need to do to get it to work?
You can address the named range directly without looping. There is no test that this named range exists, as per your description it is safe to assume so.
Secondly, do not use the "with" statement outside of the loop that sets the referenced variable. Try this instead:
Option Explicit
Sub HideEmptyRows()
Dim rngName As Range
Dim cell As Range
Application.ScreenUpdating = False
For Each cell In range("HideRows")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
edit:
If the workbook contains multiple identical sheets where each sheet may contain this named range you will have to loop. This code will not loop over all names but over all sheets, and test for existance of the named range in each sheet:
Sub HideEmptyRows()
Dim sh As Sheets
Dim rng As Range, cell As Range
For Each sh In ActiveWorkbook.Sheets
Set rng = Nothing ' this is crucial!
On Error Resume Next
Set rng = sh.Names("HideRows")
On Error GoTo 0
If Not rng Is Nothing Then
For Each cell In rng
cell.EntireRow.Hidden = (cell.Value = 0)
Next cell
End If
Next sh
End Sub
The range variable has to be reset explicitly before the assignment as this step is skipped if the range does not exist. The following If would use the value last assigned then, which would be wrong.