I'm trying to write a loop that searches every filled cell in column "J" in sheet2, and hides the corresponding row in sheet1. For example, if cell J1 was "30", row 30 in sheet1 would be hidden. Here's what I have so far:
Sub test()
Dim myrng As Range
Dim ws As Worksheet
Dim i As Integer
Dim lrow As Long, value As Long
Dim cell As Variant
Set ws = Sheet2
lrow = ws.Range("J" & Rows.Count).End(xlUp).Row
For i = 1 To lrow
value = ws.Cells(i, 10).value
cell = "A" & value
Sheet1.[cell].EntireRow.Hidden = True
Next i
End Sub
Everything is working except for the line "Sheet1.[value].entirerow.hidden=true". I'm probably using incorrect syntax. Any thoughts/help would be much appreciated!
Thanks,
Kim
Related
top part of the worksheet
very new to VBA and I'm trying to develop a macro to do some formatting. I have a variable amount of data (row wise, columns are the same) in my worksheet. After the last row of data, there are a bunch of blank white rows, and at the very bottom is a grey-shaded row. I want to hide all of the blank white rows in the middle, so that the grey-shaded row is then right under my last row with data in it.
Here is the code I have so far (note: Column I is the last column). Any help would be greatly appreciated. Right now, I am getting a "type mismatch" error for the "BeforeFinalRow = finalRow - 1" part, but I'm sure there's a lot more that's wrong with this code. Thanks in advance!
Sub hide_rows()
Dim BelowUsedData As Long
BelowUsedData = Cells(Rows.Count, 2).End(xlUp).Row + 1
Dim RowBelowUsedData As Range
RowBelowUsedData = Range("A" & BelowUsedData, "I" & BelowUsedData)
Range("A1").Select
Selection.End(xlDown).Select
Dim finalRow As Range
finalRow = Range(Selection, Selection.End(xlToRight))
Dim BeforeFinalRow As Long
BeforeFinalRow = finalRow - 1
Rng = Range(Cells(RowBelowUsedData, "A"), Cells(BeforeFinalRow, "I")).Select
Selection.EntireRow.Hidden = True
End Sub
You could simplify this and hard code your bottom border cell into the code (Just change the value of BottomBorder in code)
Option Explicit
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim LRow As Long, BottomBorder As Long
LRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Offset(1).Row
BottomBorder = 1006 'Change this if your bottom border changes
ws.Range(ws.Cells(LRow, 1), ws.Cells(BottomBorder, 1)).EntireRow.Hidden = True
End Sub
Another option is to use a WorkSheet_Change Event. This will only work if you are inputting data in one entry (row) at a time.
To implement: Hide all unused rows with the exception of 1! So if your last used cell is B4, hide B6 down to BottomBorder which will leave B5 as a white blank row where your next entry will go. Then paste the below code in the worksheet in VBE. Every time an entry is made in your blank row (B5) here, the macro will insert a new row keeping your current format.
This is dynamic so it will also look at the next blank row (After B5, B6 will be your new target row)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LRow As Long
LRow = Range("B" & Rows.Count).End(xlUp).Offset(1).Row
Application.EnableEvents = False
If Target.Row = LRow - 1 And Target.Column = 2 Then
Range("A" & LRow + 1).EntireRow.Insert (xlShiftUp)
End If
Application.EnableEvents = True
End Sub
On the photo it looks like the rows are not hidden but grey. The below code will find where the color changes and hide those white rows between the last row with data and the first grey cell:
Sub hide_rows()
Dim rngData As Range
Dim rngFirstCelltoHide As Range
Dim rngLastWhite As Range
Set rngData = Range("B1").CurrentRegion
Set rngFirstCelltoHide = rngData.Cells(rngData.Rows.Count, 1).Offset(1, 0)
Set rngLastWhite = rngFirstCelltoHide
Do Until rngLastWhite.Interior.Color <> rngLastWhite.Offset(1, 0).Interior.Color
Set rngLastWhite = rngLastWhite.Offset(1, 0)
Loop
Range(rngFirstCelltoHide, rngLastWhite).EntireRow.Hidden = True
End Sub
finalRow is a range object. That is why you get 'type error' when you subtract 1 from it. Declare the variable as long and assign row number to it as follows:
finalRow = Range(Selection, Selection.End(xlToRight)).Row
I am attempting to have VBA scan cells in column DQ for a specific text value of "AcuteTransfer" and then to cut the row containing that cell and past into the first available row of a new sheet.
This value would be listed multiple times and each listing would need to be cut and pasted over
sheet containing the cell is "adds&reactivates" and sheet where row would be pasted to is "ChangeS".
Any recommendations would be amazing.
So far I have
Sub ohgodwhathaveIdone()
Dim endRow As Long
Dim Match1() As Variant
Dim ws As Worksheet
Set ws = Worksheets("adds&reactivates")
ICount = 0
endRow = Sheets("adds&reactivates").Range("DQ999999").End(xlUp).Row
Match1 = Sheet1.Range("DQ2:DQ" & endRow)
For I = LBound(Match1) To UBound(Match1)
If Match1(I, 1) = "AcuteTransfer" Then
Sheets("adds&reactivates").Cells(I, "A").EntireRow.Copy Destination:=Sheets("changes").Range("A" & Sheets("Changes").Rows.Count).End(xlUp).Offset(1)
Else
End If
Next I
End Sub
Try this out - this is assuming both pages have headers on row 1.
Option Explicit
Sub Test()
Dim sht1 As Worksheet, sht2 As Worksheet
Dim i As Long
Set sht1 = ThisWorkbook.Worksheets("adds&reactivates")
Set sht2 = ThisWorkbook.Worksheets("ChangeS")
For i = 2 To sht1.Cells(sht1.Rows.Count, "DQ").End(xlUp).Row
If sht1.Range("DQ" & i).Value = "AcuteTransfer" Then
sht1.Range("A" & i).EntireRow.Cut sht2.Range("A" & sht2.Cells(sht2.Rows.Count, "DQ").End(xlUp).Row + 1)
End If
Next i
End Sub
I've got a beautiful Excel file which automatically imports values from CSV files into my worksheet, the data is pasted in the first empty row of my sheet.
The thing is that data can come from 3 different sources, say the column G is filled with either a 1, a 2 or a 3.
Based on the value in said column i'd like to paste the other values of that row to the first empty cell in a specific range in a different sheet. The sheet name is dependent on the Value in Column C, for which I created the following code:
Sub Lastcell()
Dim LR As String
Dim SheetName As String
LR = Cells(Rows.Count, "B").End(xlUp).Row
SheetName = Range("C" & LR).Value
If SheetExists(SheetName) Then
Else
Sheets.Add(After:=Sheets(Sheets.Count)).name = SheetName
End If
End Sub
Function SheetExists(SheetName As String, Optional Wb As Workbook) As Boolean
If Wb Is Nothing Then Set Wb = ThisWorkbook
On Error Resume Next
SheetExists = (LCase(Wb.Sheets(SheetName).name) = LCase(SheetName))
On Error GoTo 0
End Function
So I know which worksheet I’m copying to, now I want to select which row it goes to.
Say, if the value in the last cell of column G is 1, I want to copy the whole row to the first empty cell in row C, starting from C5.
if the value in the last cell of column G is 2, I want to copy the whole row to the first empty cell in row H, starting from H5.
if the value in the last cell of column G is 3, I want to copy the whole row to the first empty cell in row M, starting from M5.
My question is: How can i select a different paste range based on the value of a cell. Cell value is 1, paste to last empty cell in column A Cell value is 2, Paste to last empty cell in column B Cell value is 3, Paste to last empty cell in column C?
Something like this?
Sub tgr()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsDest As Worksheet
Dim LR As Long, NR as long
Dim DestCol As String
Set wb = ActiveWorkbook
Set wsData = wb.ActiveSheet
LR = wsData.Cells(wsData.Rows.Count, "G").End(xlUp).Row
On Error Resume Next
Set wsDest = wb.Sheets(wsData.Cells(LR, "C").Value)
On Error GoTo 0
If Not wsDest Is Nothing Then
Select Case wsData.Cells(LR, "G").Value
Case 1: DestCol = "C"
Case 2: DestCol = "H"
Case 3: DestCol = "M"
End Select
'Destination sheet and columns are now defined
'Copy over what you want to the destination
NR = wsDest.Cells(wsDest.Rows.Count, DestCol).End(xlUp).Row
If NR < 5 Then NR = 5
wsDest.Cells(NR, DestCol).Resize(, 6).Value = wsData.Cells(LR, "A").Resize(, 6).Value
End If
End Sub
I am needing to follow the protocol below:
I am scanning Sheet1 and for each unique empName on that worksheet selecting the individual empName worksheet.
on the individual empName worksheet capturing the value in the last cell in column O
Storing the value in variable tper (it's a percentage)
Selecting sheet1
Writing a header to column N1
Selecting the 1st empty cell in column N (excluding the header)
write the value of tper to the selected cell in column N
Repeat until all empNames have been processed from Sheet1
My syntax seems to execute as it should up until this line lr1 = Cells(Rows.Count, 13).End(xlUp).Row where it throws an error of
error invalid qualifier
What do I need to re-write in order for this to follow the protocol outlined above?
Function Test()
Dim lr As Long, i As Long, lr1 As Long, i1 As Long
Dim WS As Worksheet, empName As String, tper As Variant
Set WS = ActiveSheet
lr = Cells(Rows.Count, 2).End(xlUp).Row
For i = 2 To lr
empName = WS.Cells(i, 2).Value
Sheets(empName).Select
tper = "=LOOKUP(2,1/(O:O<>""),O:O)"
Sheets("Sheet1").Select
Range("N1").FormulaR1C1 = "Percent"
lr1 = Cells(Rows.Count, 13).End(xlUp).Row
For i1 = 2 To lr1
lr1.Cells.FormulaR1C1 = tper
Next i1
Next i
End Function
I have attempted to modify your code. see if this works. Since you want to loop through all employees in Sheet1, which is being taken care of by the first for loop, I got rid of the second loop.
Sub Test()
Dim empName As String, tper As Variant
Dim WS As Worksheet, empSheet As Worksheet
Set WS = Sheets("Sheet1")
Dim lr As Long
lr = WS.Cells(Rows.Count, 2).End(xlUp).Row
Dim i As Long
For i = 2 To lr
'scanning Sheet1 and for each unique empName
empName = WS.Cells(i, 2).Value
'selecting the individual empName worksheet
'just set to variable. no need to select
Set empSheet = Sheets(empName)
'on the individual empName worksheet capturing the value in the last cell in column O
'Storing the value in variable tper (it's a percentage)
tper = empSheet.Range("O" & Rows.Count).End(xlUp).Value
'Selecting Sheet1
'Writing a header to column N1
WS.Range("N1").FormulaR1C1 = "Percent"
'Selecting the 1st empty cell in column N (excluding the header)
WS.Range("N" & Rows.Count).End(xlUp).Offset(1, 0) = tper
'Repeat until all empNames have been processed from Sheet1
' next i will reapeat for the next employee in sheet 1
Next i
End Sub
You also mentioned
for each unique empName
The code does not check that.
Sorry, I feel like this is probably super basic, but I am trying to use Excel and VBA to move data from multiple cells per row into an empty column in a specific order. Some of the cells might not have data so I have to check that as well and skip empty ones with something along the lines of Value <> Empty.
Basically, what I am trying to do is take a table that looks like this (with empty column A):
B1 C1 D1 E1
B2 C2 D2 [E2empty]
B3 C3 D3 E3
And set it up like this in column A:
B1
C1
D1
E1
B2
C2
D2
B3
C3
D3
E3
It would be entered in one row at a time into the new column.
I guess I am trying to figure out how to say the following in code
In Row 1, check if cell B is empty. If not, move Value to column A, first avaible cell,
next cell in row 1, (repeat).
Next Row( do the same as row 1.)
So I was thinking of using For i = 1 To rwcnt where rwcnt is defined by CountA(Range("B:B"))
To do the rows in order and then doing a similar thing inside that for-statement for cells (Maybe j = B To E?).
So my overall goal is to scan my range (MyRange = ActiveSheet.Range("B1:E" & rwcnt)) and move everything into column A in the order described at the top, but I don't know how to move data to column A in sequence. Any advice on how to accomplish this would be very helpful.
Loop through all the used rows, looping columns starting at B in that row. Check if the cell is not empty. Write it to A next cell.
In you VBA IDE go to the tools menu and selecte references. Select "Microsoft scripting runtime"
Dim lRow As Long
Dim lRowWrite as long
Dim lCol As Long
Dim ws As Excel.Worksheet
Dim ts As TextStream
Dim fs As FileSystemObject
'Create the text file to write to
Set fs = New FileSystemObject
Set ts = fs.CreateTextFile("C:\Temp\test.txt", True, False)
Application.ScreenUpdating = False
Set ws = Application.ActiveSheet
lRowWrite = 1
lRow = 1
'Loop through all the rows.
Do While lRow <=ws.UsedRange.Rows.count
'Loop through all the columns
lCol = 2
Do While lCol <=ws.UsedRange.Columns.count
'Check if it is empty
If not isempty(ws.Cells(lRow, lCol)) Then
'Not empty so write it to the text file
ts.WriteLine ws.Cells(lRow, lCol)
End If
lCol = lCol + 1
Loop
lRow = lRow + 1
ws.Range("A" & lRow).Activate
Loop
Application.ScreenUpdating = True
ts.Close: Set ts = Nothing
Set fs = Nothing
Try this:
Sub test()
Dim lastCol As Long, lastRow As Long, k As Long, i As Long, colALastRow As Long
Dim rng As Range
Dim ws As Worksheet
'Columns(1).Clear ' uncomment this if you want VB to force Col. A to be cleared
Application.ScreenUpdating = False
Set ws = ActiveSheet
lastCol = ws.UsedRange.Columns.Count 'This will get the last column
lastRow = ws.UsedRange.Rows.Count 'this will get the last used row
k = 2 'Set k to 2, to start in Col B
colALastRow = 1 'This starts at 1, since your entire Column A is empty
With ws
For i = 1 To lastRow
lastCol = .Cells(i, 2).End(xlToRight).Column
Set rng = .Range(.Cells(i, 2), .Cells(i, lastCol))
' rng.Select
rng.Copy
.Range(.Cells(colALastRow, 1), .Cells(colALastRow + (lastCol), 1)).PasteSpecial Paste:=xlPasteAll, operation:=xlNone, skipblanks:=False, Transpose:=True
Application.CutCopyMode = False
colALastRow = .Cells(1, 1).End(xlDown).Row + 1
Next i
End With
Application.ScreenUpdating = True
MsgBox ("Done!")
End Sub
Edit: Changed the lastCol, lastRow, etc. from Integer to Long, since there will be over 32,767 rows.
Edit 2: I commented out rng.Select. This is because there's no reason to select it for the Macro. I only had it there, because as I worked through the macro (using F8), I wanted to make sure it was grabbing the right ranges. It is, so you can comment this out. It might even make it run slightly faster :)