I am having an issue returning my checkbox information from an excel userform I created back to the database in excel. It keeps placing the active worksheet instead of sheet 2 in my excel workbook.
Sub CheckBox2_Click()
Dim iRow As Long
iRow = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
If CheckBox2 Then
Range("G" & iRow) = "Received"
Else
Range("G" & iRow).ClearContents
End If
End Sub
I was thinking I need to set the below to make it work but it didn't help.
iRow = Application.Workbooks("PIDParcelUtilities.xlsm").Worksheets("PIDParcelUtilitiesData").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
It keeps placing the active worksheet
That's by design.
iRow = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
Which worksheet is Range referring to?
Range("G" & iRow) = "Received"
Unqualified Range calls in a class module (a UserForm is a class) implicitly refer to ActiveSheet.
Pull the worksheet object reference you mean to work with:
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("PIDParcelUtilitiesData")
And then you can use is to qualify these Range calls:
iRow = ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1).Row
If CheckBox2 Then
ws.Range("G" & iRow) = "Received"
Else
ws.Range("G" & iRow).ClearContents
End If
Related
I need that after a userform is submited that row and cells are locked.
When you insert data in userform those data go to tab called "table". I need tab TABLE to be locked and to allow only userform input.
I need rows and cells from A4 to AF4 onwards to be locked for editing.
I tried with this code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRange As Range
Set MyRange = Intersect(Range("A1:D100"), Target)
If Not MyRange Is Nothing Then
Sheets("Sheet1").Unprotect password:="hello"
MyRange.Locked = True
Sheets("Sheet1").Protect password:="hello"
End If
End Sub
This is how my command button looks
Private Sub CommandButton2_Click()
Dim sh As Worksheet, lastRow As Long
Set sh = Sheets("Details")lastRow = sh.Range("A" & Rows.Count).End(xlUp).row + 1
sh.Range("A" & lastRow).value = TextBox3.value
sh.Range("B" & lastRow).value = TextBox4.Text
sh.Range("C" & lastRow).value = TextBox5.Text
Unload Me
End sub
First, manually lock the cells from A4:AF[ChooseTheLastRow] and then protect the worksheet with a password and do not allow the selecting of locked cells.
Then in your code do this.
Private Sub CommandButton2_Click()
Dim sh As Worksheet
Set sh = Sheets("Details") 'you called this TABLE in your text above, no?
With sh
.unprotect "PASSWORD"
Dim lastRow As Long
lastRow = .Range("A" & Rows.Count).End(xlUp).row + 1
.Range("A" & lastRow).value = TextBox3.value
.Range("B" & lastRow).value = TextBox4.Text
.Range("C" & lastRow).value = TextBox5.Text
.protect "PASSWORD"
End With
End sub
I'm trying (and failing) to get some code to run on each worksheet except one specific sheet. I want the code to just cut the data in cells n2:s2 and paste it in t1:y1, then repeat for any other rows that have data in columns n3:s3, n4:s4, n5:s5.
Once there is no data (row 6 i believe), it should move onto the next sheet (except "Report" sheet).
The problem i'm facing when i debug is it moves the data as expected, then starts again on the same sheet, so overwrites data with empty cells.
Sub MovethroughWB()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets 'This statement starts the loop
If ws.Name <> "Report" Then 'Perform the Excel action you wish (turn cell yellow below)
Range("N2:S2").Select
Selection.Cut Destination:=Range("T1:Y1")
Range("T1:Y1").Select
Range("N3:S3").Select
Selection.Cut Destination:=Range("Z1:AE1")
End If
Next ws
End Sub
I'm sure its something basic, but can't find what!
Try:
Sub MovethroughWB()
Dim ws As Worksheet
Dim i As Long, Lastrow As Long, Lastcolumn As Long
For Each ws In ThisWorkbook.Worksheets 'This statement starts the loop
If ws.Name <> "Report" Then 'Perform the Excel action you wish (turn cell yellow below)
With ws
Lastrow = .Cells(.Rows.Count, "N").End(xlUp).Row
For i = 2 To Lastrow
If .Range("N" & i).Value <> "" And .Range("O" & i).Value <> "" And .Range("P" & i).Value <> "" _
And .Range("Q" & i).Value <> "" And .Range("R" & i).Value <> "" And .Range("S" & i).Value <> "" Then
If .Range("T1").Value = "" Then
.Range("N" & i & ":S" & i).Cut .Range("T1:Y1")
Else
Lastcolumn = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
.Range("N" & i & ":S" & i).Cut .Range(.Cells(1, Lastcolumn), .Cells(1, Lastcolumn + 5))
End If
End If
Next i
.Rows("2:" & Lastrow).EntireRow.Delete
End With
End If
Next ws
End Sub
Need some assistance. I have a template that gets data exported into it from a different program. The rows of data varies from export to export and a new workbook is needed for each export.
I, currently, have a 'Master' macro written that cleans up the worksheet (formats, text to numbers, etc.) and also adds checkboxes to the end of each row that contains data. These checkboxes are linked to a cell. Once the operator completes the worksheet, they will then need to check a checkbox for each row of data that is 'out of spec'. These rows will then be copied onto the next sheet in the workbook. This is triggered by a button. My current macro works other than copying the entire row of data when I only want to copy over cells in columns 'A' through 'I'. Cells in columns 'J' and out contain data that does NOT need to be copied.
Here is my current macro that, like I said, copies the entire row:
Sub CopyRows()
Dim LRow As Long, ChkBx As CheckBox, WS2 As Worksheet
Set WS2 = Worksheets("T2 FAIR (Single Cavity)")
LRow = WS2.Range("A" & Rows.Count).End(xlUp).Row
For Each ChkBx In ActiveSheet.CheckBoxes
If ChkBx.Value = 1 Then
LRow = LRow + 1
WS2.Cells(LRow, "A").Resize(, 14) = Range("A" & _
ChkBx.TopLeftCell.Row).Resize(, 14).Value
End If
Next
End Sub
In the right-side of your equation, your Range() object is not properly qualified (with a worksheet). So, I used the fake wsX in this example.
Also, I used the ending column of "D" - but you can change to whatever you need it to be.
LRow = LRow + 1
r = ChkBx.TopLeftCell.Row
ws2.Range(ws2.Cells(LRow, "A"), ws2.Cells(LRow, "D")) = wsX.Range( _
wsX.Cells(r, "A"), wsX.Cells(r, "D"))
or
ws2.Range("A" & LRow & ":D" & LRow) = wsX.Range("A" & r & ":D" & r)
From Comment:
The templates ALWAYS start, with the imported data, in "A19". When I run this macro, to copy the checked data to the next worksheet, it starts in with cell "A18". I have no idea as to why. How do I specify that the checked data is to be copied starting with "A19" on the next worksheet?
If it's always off by one, you can just add 1. I am not sure how your layout is, so this will be something you will have to either add to LRow or r. So either
ws2.Range("A" & LRow + 1 & ":D" & LRow + 1) = ...
or
... = wsX.Range("A" & r + 1 & ":D" & r + 1)
Answer is as follows:
Sub CopyRows()
Dim ws1 As Worksheet
Set ws1 = Worksheets("T1 FAIR (Single Cavity)")
Dim ws2 As Worksheet
Set ws2 = Worksheets("T2 FAIR (Single Cavity)")
Dim LRow As Long
LRow = ws2.Range("A" & rows.count).End(xlUp).row
Dim r As Long
Dim ChkBx As CheckBox
For Each ChkBx In ws1.CheckBoxes
If ChkBx.value = 1 Then
LRow = LRow + 1
r = ChkBx.TopLeftCell.row
ws2.Range("A" & LRow + 1 & ":I" & LRow + 1).value = _
ws1.Range("A" & r & ":I" & r + 1).value
End If
Next
End Sub
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'm trying to write a short macro that includes a line that averages a range of cells. In each worksheet that I want to run the macro in the range of cells is a different length.
After running the macro the cell E1 contains "=AVERAGE(Rng)"
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(Rng)"
Range("E2").Formula = "=STDEV(Rng)"
Range("E3").Select
ActiveWindow.SmallScroll Down:=-2
End Sub
I've also tried
Range("E1").Formula = "=Average(Range("B2:B" & lastRow))"
without trying to use Set Rng = Range("B2:B" & lastRow)
You need to use Rng.Address in your formulas. Try to change your code into this:
Sub Avg()
Dim homeSheet As Worksheet
Set homeSheet = ActiveSheet
Dim lastRow As Long
Dim Rng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
Set Rng = Range("B2:B" & lastRow)
Range("E1").Formula = "=Average(" & Rng.Address & ")"
Range("E2").Formula = "=STDEV(" & Rng.Address & ")"
Range("E3").Select
End Sub
If you were to use the second method you have tried, you would need to change that line of code to:
Range("E1").Formula = "=Average(" & Range("B2:B" & lastRow).Address & ")"