I have some VBA code which highlights the cells in A if they contain a value.
Is there a way to adapt this to start in cell A2 as A1 is a header.
Option Explicit
Sub LRow()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<=== Edit Sheet Name
Dim LRow As Long
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A1:A" & LRow).Select
End Sub
You only need to change the starting cell to A2: ws.Range("A2:A" & LRow).Select
In your code it looks like this:
Sub LRow()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<=== Edit Sheet Name
Dim LRow As Long
LRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & LRow).Select
End Sub
Related
Am I missing something here? I'm getting a 1004 during debug
Sub perc()
Dim lastRow As Long
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Range("G2:G" & lastRow).Formula = "=IF((AND(A2<>"",F2>0)),F2/C2, "")"
End Sub
You need to qualify your objects - What workbook/worksheet does the Range and Rows object exist on? The assumed object references may be incorrect
You need to double up on your blank quote strings inside the formula
Sub Perc()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim lr As Long
lr = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("G2:G" & lr).Formula = "=IF((AND(A2<>"""", F2>0)), F2/C2, """")"
End Sub
I am using this line to find the end of a dynamic range starting in B9:
Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Rows.Count).End(xlUp))
The range may anywhere from 2 rows long to 20 rows long but I need to set a limit to the range at 21 rows.
How do I do this?
Thanks
Find the last row and check if it is greater then 21. If it is, then set the last row as 21. See this. Also it is advisable to work with objects and variables. Code becomes easier to handle :)
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim lRow As Long
Dim rng As Range
Dim lRowLimit As Long
Set ws = ThisWorkbook.Sheets("Summary")
'~~> Set the limit here
lRowLimit = 21
With ws
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
If lRow > lRowLimit Then lRow = lRowLimit
Set rng = .Range("B9:B" & lRow)
Debug.Print rng.Address
End With
End Sub
The range may anywhere from 2 rows long
Note: In such a case you want .Range("B9:B" & lRow) to be .Range("B1:B" & lRow)?
You need to count the rows in the same worksheet as you set the range. Therefore:-
Set Rng = Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Sheets("Summary").Rows.Count).End(xlUp))
But if you want to limit the end row you should determine a row number, like this.
Dim Rng As Range
Dim Rl As Long ' last row
With Sheets("Summary")
Rl = WorksheetFunction.Min(.Range("B" & .Rows.Count).End(xlUp).Row, 21)
Set Rng = Range(.Range("B9"), .Cells(Rl, "B"))
End With
Also
Sub Test()
Const MaxRow = 29
Dim MyRange As Range
With Sheets("Summary")
Set MyRange = .Range("B9", "B" & IIf(.Range("B" & Rows.Count).End(xlUp).Row > MaxRow, MaxRow, _
.Range("B" & Rows.Count).End(xlUp).Row))
End With
End Sub
I am trying to create code (Loop) so that when a task is allocated to a team member (in a cell in column H) the code searches the cell value with the existing sheet names and if there is a match, the sheet then makes the task member sheet active sheet, finds the last available line and adds the allocated tasks to the sheet. The code should run for all filled cells in the column.
However, the code i have currently written bugs out. I am finding it hard to define the worksheetname (Cell value) etc.
Sub TaskAllocation()
Dim cell As Range, Lastrow1 As Double, i As Integer
Dim SubTaskWs As Worksheet, Ws As Worksheet, Lastrow2 As Double
Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")
Set Ws = ActiveWorkbook.Sheets(WsName)
i = o
Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row
Lastrow2 = Ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In SubTaskWs.Range("H4:H" & Lastrow1)
For Each Ws In Sheets
If cell.value = Ws.Name Then
Ws.Range("A" + (Lastrow2 + (i))).EntireRow.Insert
Call copyFormattingAbove(Ws, "A" & Lastrow2)
Ws.Range(("A" & Lastrow2) + (i)).value = cell.Offset(, -6)
Ws.Range(("B" & Lastrow2) + (i)).value = cell.Offset(, -5)
i = i + 1
End If
Next Ws
Next cell
End Sub
I did change a bit your code to make it more readable.
Some tips for the future:
Use the Option Explicit on the top of your moduel to fource the declaration of all your variables.
Always try to declare your variables close to where they are used.
Never declare a integervariable, use Long instead. Don't use Double for rows either, Double and Single are for floating numbers.
Here is the code:
Option Explicit
Sub TaskAllocation()
Dim cell As Range
Dim SubTaskWs As Worksheet
Set SubTaskWs = ActiveWorkbook.Worksheets("Sub tasks")
Dim Lastrow1 As Long
Lastrow1 = SubTaskWs.Range("H" & Rows.Count).End(xlUp).Row
Dim ws As Worksheet
Dim cell As Range
Dim Lastrow2 As Long, i As Long
i = 0
Dim Tasks As Object
FillTasks Tasks
For Each cell In SubTaskWs.Range("H4:H" & Lastrow1) 'change this range and loop through the column with the tasks
If Tasks.Exists(cell) Then GoTo AlreadyDone
For Each ws In Sheets
If SubTaskWs.Cells(cell.Row, "H") = ws.Name Then
Lastrow2 = ws.Range("A" & Rows.Count).End(xlUp).Row + 1
copyFormattingAbove ws, "A" & Lastrow2
ws.Range("A" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 2)
ws.Range("B" & Lastrow2).Value = SubTaskWs.Cells(cell.Row, 3)
End If
Next ws
AlreadyDone:
Next cell
End Sub
Function FillTasks(Tasks As Object)
Set Tasks = CreateObject("Scripting.Dictionary")
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'loop through sheets
If Not ws.Name = "Sub tasks" Then
'code to find the right columnd and loop through the existing tasks
'there is no need for an item on this case, you only need to know if it exists
If Not Tasks.Exists(cell) Then Tasks.Add cell, 1
End If
Next ws
End Function
I am trying to paste values from a bunch of tables into one long list. I have the tables spread across different sheets and the number of rows changes, but the columns do not. Then I am also trying to paste a string value that tells what sheet it came from, but having trouble with the active cell part of the code.
When I first tried it, it did not compile, hence why I came here, to figure out why it did not compile. Going back and forth with urdearboy, below, I was able to get the correct code working here.
I have the following:
sub copypaste()
Dim ws1 as worksheet
dim ws2 as worksheet
dim mas as worksheet
Set ws1 =ThisWorkbook.Sheets("Sheet1")
Set ws2=ThisWorkbook.Sheets("Sheet2")
Set mas=ThisWorkbook.Sheets("Master") 'where I create my list
For Each ws In Worksheets
If ws.Name <> mas.Name Then
LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1, 0).Row
wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & wsLRow - 1).Copy
mas.Range("A" & LRow).PasteSpecial Paste:=xlPasteValues
ws.Range("B2:B" & wsLRow - 1).Copy
mas.Range("B" & LRow).PasteSpecial Paste:=xlPasteValues
mas.Range(mas.Cells(LRow, 4), mas.Cells(wsLRow + LRow - 2, 4)) = ws.Name 'I need my sheet value in the fourth column, not the third, but simply change the col coordinate in the Cells equation above
End If
Next ws
'In order to figure out the sheet name, I used the following:
Dim rng As Range
Set rng = mas.Range("D2", Range("D2").End(xlDown))
For Each Cell In rng
If Cell.Value = "Sheet 1" Then
Cell.Value = "S1"
ElseIf Cell.Value = "Sheet 2" Then
Cell.Value = "S2"
End If
Next Cell
end sub
This will loop through all sheets, with the exception of Master, and import the values on Column A to Master accompanied by the origin of the data (sheet name).
Option Explicit for good measure.
Option Explicit
Sub copypaste()
Dim mas As Worksheet: Set mas = ThisWorkbook.Sheets("Master")
Dim ws As Worksheet, LRow As Long, wsLRow As Long
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> mas.Name Then
LRow = mas.Range("A" & mas.Rows.Count).End(xlUp).Offset(1).Row
wsLRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
mas.Range(mas.Cells(LRow, 2), mas.Cells(wsLRow + LRow - 2, 2)) = ws.Name
End If
Next ws
Application.ScreenUpdating = True
End Sub
To paste values change
ws.Range("A2:A" & wsLRow).Copy mas.Range("A" & LRow)
to this
ws.Range("A2:A" & wsLRow).Copy
mas.Range("A" & LRow).PasteSpecial xlPasteValues
I just want to add an offset (0,6) to my lastRow . any help?
lastRow = oSht.Range(vari1 & Rows.Count).End(xlUp).Row
After your clarification I could suggest that you could do it by range expansion. Instead of Offset you could use Resize.
As you said this is working correct for your S column:
oSht.Range(vari2, vari1 & lastRow).Select
After we add resize to that you get your new range:
oSht.Range(vari2, vari1 & lastRow).Resize(,6).Select
I think this is what you want?
Option Explicit
Sub Sample()
Dim oSht As Worksheet
Dim lastRow As Long
Dim Rng As Range
Dim vari1 As String
'~~> Change this to the relevant column letter
vari1 = "S"
'~~> Change this to the relevant sheet
Set oSht = ThisWorkbook.Sheets("Sheet1")
With oSht
lastRow = .Range(vari1 & .Rows.Count).End(xlUp).Row
Set Rng = .Range(vari1 & 2 & ":" & .Range(vari1 & lastRow).Offset(, 6).Address)
'~~> S2:X32 in your case if lastrow is 32
Debug.Print Rng.Address
End With
End Sub