Very new to this but enjoying the journey.
I am trying to populate a cell then click a button to run the macro. Problem is I have the code all working if I include the cells value in the code.....
Sub CopyRowBasedOnCellValue()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Sheet1").UsedRange.Rows.Count
B = Worksheets("Sheet2").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Sheet1").Range("C1:C" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "ASML" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & B + 1)
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
But I want "ASML" not to be constant. I need it to be variable (ie the value of cell K1)
I am sure it is a simple fix but not very good at this
Bosnia
Related
Sub fadfadsf()
'Declare variables
Dim DataRg As Range
Dim DataCell As Range
Dim P As Long
Dim J As Long
Dim I As Long
'Set variables
P = Worksheets("EquipOtherPortfolio").UsedRange.Rows.Count
Q = Worksheets("Modifiedby RDS_EquipmentOther").UsedRange.Rows.Count
''Type If condition to relate the variables I and Q
If I = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Modifiedby RDS_EquipmentOther").UsedRange) = 0 Then Q = 0
End If
'Set range for Dataset1
Set DataRg = Worksheets("EquipOtherPortfolio").Range("J2:J2" & P)
On Error Resume Next
Application.ScreenUpdating = False
'Apply the For loop
For I = 1 To DataRg.Count
'Set Condition for "" value
If CStr(DataRg(I).Value) = "Files" Then
- - '**Apply command to copy cells ' When I change **"A" to "A10"** it will not show any resluts not sure where is the disconnect.**
DataRg(I).EntireRow.Range("I1:N1").Copy Destination:=Worksheets("Modifiedby RDS_EquipmentOther").Range("A" & Q + 1)
Q = Q + 1
End If
Next
Application.ScreenUpdating = True
End Sub
In apply command to copy cell section I tried changing "A" to "A10" but is not showing me results and could not figured out how to change variables.
Sub MoveRowtoAnotherTab()
'Created by Ruchita Rane
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Contact").UsedRange.Rows.Count
B = Worksheets("Lead Created").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Lead Created").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Contact").Range("C1:C" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(A).Value) = "1" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Lead Created").Range("A" & B + 1)
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
My variable is K=1 to move the row from one sheet to another and I do not want to erase data in Contact. I am not good in VBA, Can someone please help?
I think you needed to change A to C in line If CStr(xRg(A).Value) = "1" Then
Option Explicit
Sub MoveRowtoAnotherTab()
'Created by Ruchita Rane
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Contact").UsedRange.Rows.Count
B = Worksheets("Lead Created").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Lead Created").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Contact").Range("C1:C" & A)
'On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) = "1" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Lead Created").Range("A" & B + 1)
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
I tried this, which returned the rows I want, so a good start. But I really just need the value in Column B, not the entire row. What I really want is to list the value in column B if the value in column C is <>"" and column D <>"". Results in Quote sheet starting in cell C4.
Sub CopyQuoteValues()
Dim xRg As Range
Dim xCell As Range
Dim A As Long
Dim B As Long
Dim C As Long
A = Worksheets("Software Options").UsedRange.Rows.Count
B = Worksheets("Quote").UsedRange.Rows.Count
If B = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Quote").UsedRange) = 0 Then B = 0
End If
Set xRg = Worksheets("Software Options").Range("C17:C" & A)
On Error Resume Next
Application.ScreenUpdating = False
For C = 1 To xRg.Count
If CStr(xRg(C).Value) <> "" Then
xRg(C).EntireRow.Copy Destination:=Worksheets("Quote").Range("A" & B + 1)
B = B + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Something like this should do what you need:
Sub CopyQuoteValues()
Dim wsOpt As Worksheet, wsQuote As Worksheet
Dim c As Range, rngDest As Range
Set wsOpt = Worksheets("Software Options")
Set wsQuote = Worksheets("Quote")
Set rngDest = wsQuote.Range("C4")
For Each c In wsOpt.Range("C17", wsOpt.Cells(wsOpt.Rows.Count, "C").End(xlUp)).Cells
If Len(c.Value) > 0 And Len(c.Offset(0, 1)) > 0 Then 'value in C and D ?
c.Offset(0, -1).Copy rngDest 'copy ColB
Set rngDest = rngDest.Offset(1, 0) 'next paste location
End If
Next c
End Sub
I have a range A6:A24 that is blank. I want to paste the value 1 into each cell and copy a resulting calculation in H9 to a new sheet. After that I want to move to the next cell paste "1" but delete the previous "1" and paste the resulting value.
I am either able to paste 1 into every box or just the top.
A6:A24 are years. I am trying to pull the calculation for when each year is equal to 1 (100 percent) meaning all other years need to be equal to zero.
Private Sub CommandButton1_Click()
Dim inputRange1 As Range
Dim inputRange2 As Range
Dim c As Range
Dim i As Long
Dim b As Range
Dim j As Long
Set dvCell2 = Worksheets("Sheet1").Range("A6:A24")
Set inputRange2 = Worksheets("Sheet1").Range("D1")
Set dvCell1 = Worksheets("Sheet2").Range("C1")
Set inputRange1 = Worksheets("Sheet1").Range("B6:B24")
i = 1
j = 1
Application.ScreenUpdating = False
For Each b In inputRange2
dvCell2.Value = b.Value
For Each c In inputRange1
dvCell1.Value = c.Value
Worksheets("Sheet4").Cells(i + 2, j + 3).Value = Worksheets("Sheet3").Range("H9").Value
i = i + 1
Next c
j = j + 1
i = 1
Next b
Application.ScreenUpdating = True
End Sub
Not sure I follow. This will loop through each cell in dvcell2 and put a 1 in it and then copy the value of H9. I'm not sure if you're attempting to do something else.
Private Sub CommandButton1_Click()
Dim inputRange1 As Range
Dim inputRange2 As Range
Dim c As Range
Dim i As Long
Dim b As Range
Dim j As Long
Set dvcell2 = Worksheets("Sheet1").Range("A6:A24")
Set inputRange2 = Worksheets("Sheet1").Range("D1")
Set dvCell1 = Worksheets("Sheet2").Range("C1")
Set inputRange1 = Worksheets("Sheet1").Range("B6:B24")
i = 1
j = 1
Application.ScreenUpdating = False
For Each b In dvcell2
dvcell2.value=0
b.Value = 1
Worksheets("Sheet4").Cells(i + 2, j + 3).Value = Worksheets("Sheet3").Range("H9").Value
j = j + 1
Next b
Application.ScreenUpdating = True
End Sub
I am a complete beginner with Excel VBA. I am trying to produce a schedule tracker which has on the "Courses" worksheet all the teaching information of courses running.
Column E uses a formula to identify the cell which cross references the staff member and the course date.
Column K contains the concat (text & Numerical data) statement which I need to have inserted into the correct place on the "Calendar" worksheet (same workbook).
The Code I have so far is shown below:
Private Sub BtnUpdate_Click()
Dim w As Variant
Dim c As Variant
Dim i As Integer
Dim n As Integer
'Application.ScreenUpdating = False
i = 1
w = Sheets("Courses").Range("E" & i).Value
c = Sheets("Courses").Range("K" & i).Value
Do
Sheets("Calendar").Range(w).Select
ActiveCell.Value = c.Value
Loop While n <> Range("E2").End(xlDown).Row
'Application.ScreenUpdating = True
End Sub
Any guidance would be greatly appreciated.
Not too clear .. but you may try this ..
Private Sub BtnUpdate_Click()
Dim w As Variant
Dim c As Variant
Dim i, n As Integer
Dim r as Range
Set r = Range("E65536").End(xlup)
'Application.ScreenUpdating = False
For i = 1 to r.Row
w = Sheets("Courses").Range("E" & i).Value
c = Sheets("Courses").Range("K" & i).Value
Sheets("Calendar").Range(w).Select
ActiveCell.Value = c.Value
'Application.ScreenUpdating = True
Next
End Sub