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
Related
I need to fill down a value in Sheet 1 Cell A2 with =Sheet 2 Cell A2 until the linked value is blank. I dont really know what to do.
I got so far so that I only need zeros in the fields:
Sub Test1()
Dim x As Integer
Dim i As Integer
Dim wsh As Worksheet
Set wsh = Worksheets("List with Weights")
Application.ScreenUpdating = False
i = 2
While (wsh.Cells(i, 1)) <> ""
wsh.Cells(i, 1).FormulaR1C1 = "='Sample Weight'!RC[0]"
wsh.Cells(i, 2).FormulaR1C1 = "='Sample Weight'!RC[0]"
wsh.Cells(i, 3).FormulaR1C1 = "='IS Weight'!RC[-1]"
i = i + 1
Wend
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Columns("A:C").Select
Columns("A:C").EntireColumn.AutoFit
Application.ScreenUpdating = True
Range("A1").Select
End Sub
If I have understood you correctly, there is no need for a loop. Is this what you are trying?
Option Explicit
Sub Sample()
Dim wsThis As Worksheet
Dim wsThat As Worksheet
Dim wsOther As Worksheet
'~~> Set your relevant worksheets
Set wsThis = ThisWorkbook.Sheets("List with Weights")
Set wsThat = ThisWorkbook.Sheets("Sample Weight")
Set wsOther = ThisWorkbook.Sheets("IS Weight")
'~~> Find the last row in Col A of Sample Weight worksheet
Dim wsThatLRow As Long
wsThatLRow = wsThat.Range("A" & wsThat.Rows.Count).End(xlUp).Row
'~~> Insert the formula in 1 go in the relevant range
With wsThis
.Range("A2:A" & wsThatLRow).Formula = "='" & wsThat.Name & "'!A2"
.Range("B2:B" & wsThatLRow).Formula = "='" & wsThat.Name & "'!B2"
.Range("C2:C" & wsThatLRow).Formula = "='" & wsOther.Name & "'!B2"
End With
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 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
I need to compare values on two separate sheets, both are in column H starting at 2. One sheet is labeled final, the other data. If it is in final and not in data then highlight in final. If something found in data is not in final copy it into final (whole row) at the bottom. It is all text. Column H is titled "Reference".
code 1
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 8 Then Exit Sub
Dim lastRow As Long
Dim rng As Range, cell As Range
lastRow = Range("H" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then lastRow = 2
Set rng = Range("H2:H" & lastRow)
For Each cell In rng
With Sheets("data")
a = Application.VLookup(cell.Value, .Range("H2:H" & .Range("H" & Rows.Count).End(xlUp).Row), 1, 0)
If IsError(a) Then
cell.Interior.Color = vbYellow
Else
cell.Interior.Color = xlNone
End If
End With
Next
Application.EnableEvents = True
End Sub
code 2
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Column <> 8 Then Exit Sub
Dim lastRow As Long
Dim rng As Range, cell As Range
lastRow = Range("H" & Rows.Count).End(xlUp).Row
If lastRow < 2 Then lastRow = 2
Set rng = Range("H2:H" & lastRow)
For Each cell In rng
With Sheets("final")
a = Application.VLookup(cell.Value, .Range("H2:H" & .Range("H" & Rows.Count).End(xlUp).Row), 1, 0)
If IsError(a) Then
cell.Copy .Range("H" & .Range("H" & Rows.Count).End(xlUp).Row)
End If
End With
Next
Application.EnableEvents = True
End Sub
I want to hide rows that have a zero values in columns B & C. My code works but only on the active worksheet. I want it to loop through all worksheets in the workbook. Any help is appreciated
Private Sub CommandButton1_Click()
Dim M As Long, LastRow As Long
Dim ws As worksheet
For Each ws In ActiveWorkbook.Worksheets
LastRow = ws.Range("E65536").End(xlUp).Row
For M = LastRow To 7 Step -1
If Range("B" & M).Value = 0 And Range("C" & M).Value = 0 Then
Range("B" & M).EntireRow.Hidden = True
End If
Next M
Next ws
End Sub
activate the sheet. The issue is that Range is working off the current active sheet. If you use ws. infromt of range or activate the worksheet such as below.
For Each ws In ActiveWorkbook.Worksheets
add
ws.Activate
I found this about the subject, I hope it helps: ExtendOffice
Sub Hide_rows()
Dim LastRow As Long
Dim Rng As Range
LastRow = Range("A65536").End(xlUp).Row '
Set Rng = Range("A1:A" & LastRow) '
Application.ScreenUpdating = False
For Each cell In Rng
If cell.Value = "0" Then
cell.EntireRow.Hidden = True
End If
Next cell
Application.ScreenUpdating = True
End Sub
You need to specify the Range as a member of the worksheet like so:
Private Sub CommandButton1_Click()
Dim M As Long, LastRow As Long
Dim ws As worksheet
For Each ws In ActiveWorkbook.Worksheets
LastRow = ws.Range("E65536").End(xlUp).Row
For M = LastRow To 7 Step -1
' Notice how 'ws' has been added before range
If ws.Range("B" & M).Value = 0 And ws.Range("C" & M).Value = 0 Then
ws.Range("B" & M).EntireRow.Hidden = True
End If
Next M
Next ws
End Sub