Can anyone help me?
Actually i am looking for vba script in excel:
i want to change cell location from $c$3 to $d$3 in each iteration
i am trying to use chr method but not working.
Dashboard is my sheet name
ActiveChart.SeriesCollection(2).Name = "=DashBoard!$c$8" 'changes,in next iteration it should change to $d$8 and so on till j
ActiveChart.SeriesCollection(2).Values = "=DashBoard!$c$9:$c$22" 'changes,in next iteration it should change to $d$9:$d$22 and so on till j
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim t As Integer
Dim associatedChar
t = 67
For i = 1 To 2
For j = 1 To 8
For k = 1 To 8
If (Check(i, j, k) = True) Then
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Select
ActiveChart.SeriesCollection(1).Name = "=DashBoard!$C$8"
ActiveChart.SeriesCollection(1).Values = "=DashBoard!$C$9:$C$22"
associatedChar = Chr(67)
'this is i am trying to use my associate value is intially $c$8 in next
'iterattion i want it to change to $d$8 then to $e$8 and so on.`enter code here`
ActiveChart.SeriesCollection(2).Name = "=DashBoard!$associatedChar$8" 'changes
ActiveChart.SeriesCollection(2).Values = "=DashBoard!$associatedChar$9:$associatedChar$22" 'changes
ActiveChart.SeriesCollection(1).XValues = "=DashBoard!$B$9:$B$22"
ActiveChart.SeriesCollection(2).XValues = "=DashBoard!$B$9:$B$22"
End If
Next k
Next j
Next i
End Sub
Does replacing associatedChar with " & associatedChar& " within the code help at all?
You would want to use .Cells references instead of .Range. Cells(row, col) can use numbers instead of a string reference like Range.
For example:
Dim LastRow As Long
LastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).row
For row = 2 to LastRow
Sheets("Sheet1").Cells(row, 2) = whatever.
Next row
Related
I have a table in an active worksheet.
I am trying to:
Scan Columns(A:M) of Row 6 to see if all cells are empty
If yes, then scan Columns (N:R) of Row 6 to see if all cells are empty
If 2. is false, then copy above row's Columns (A:I) in Row 6
Repeat 1-3 but on Row 7
This process should repeat until the rows of the table end.
I would like to incorporate ActiveSheet.ListObjects(1).Name or something similar to duplicate the sheet without having to tweak the code.
How I can make this as efficient and as risk free as possible? My code works but it's really too much.
Sub CopyPasteRow()
Dim lr As Long
Dim x As Long
Dim y As Long
Dim a As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
a = 0
For x = 6 To lr
For y = 1 To 13
If Not IsEmpty(Cells(x, y)) Then
a = a + 1
End If
Next y
If a = 0 Then
For y = 14 To 18
If Not IsEmpty(Cells(x, y)) Then
a = a + 1
End If
Next y
Else
a = 0
End If
If a <> 0 Then
For y = 1 To 13
Cells(x, y).Value = Cells(x - 1, y).Value
Next y
End If
a = 0
Next x
End Sub
This is the final code based on #CHill60 code. It got me 99% where I wanted.
Sub CopyPasteRow()
Dim lr As Long
Dim x As Long
Dim a As Long
Dim r As Range, r2 As Range, r3 As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 6 To lr
'check columns A to M for this row are empty
Set r = ActiveSheet.Range("A" & CStr(x) & ":M" & CStr(x))
'check columns N to R for this row are empty
Set r2 = ActiveSheet.Range("N" & CStr(x) & ":R" & CStr(x))
If WorksheetFunction.CountA(r) = 0 And WorksheetFunction.CountA(r2) <> 0 Then
'copy the data into columns A to M
Set r3 = ActiveSheet.Range("A" & CStr(x) & ":I" & CStr(x))
r3.Value = r3.Offset(-1, 0).Value
End If
Next x
End Sub
Instead of looking at individual cells, look at Ranges instead. Consider this snippet of code
Sub demo()
Dim x As Long
For x = 6 To 8
Dim r As Range
Set r = Sheets(1).Range("A" & CStr(x) & ":M" & CStr(x))
Debug.Print r.Address, MyIsEmpty(r)
Next x
End Sub
I have a function for checking for empty ranges
Public Function MyIsEmpty(rng As Range) As Boolean
MyIsEmpty = WorksheetFunction.CountA(rng) = 0
End Function
I use this because the cell might "look" empty, but actually contain a formula.
Note I've explicitly said which sheet I want the Cells from - users have a habit of clicking places other than where you think they should be! :laugh:
Edit after OP comment:
E.g. your function might look like this
Sub CopyPasteRow()
Dim lr As Long
Dim x As Long
Dim a As Long
Dim r As Range, r2 As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
For x = 6 To lr
a = 0
'check columns A to M for this row are empty
Set r = Sheets(1).Range("A" & CStr(x) & ":M" & CStr(x))
If Not MyIsEmpty(r) Then
a = a + 1
End If
If a = 0 Then
'check columns N to R for this row are empty
Set r2 = Sheets(1).Range("N" & CStr(x) & ":R" & CStr(x))
If Not MyIsEmpty(r2) Then
a = a + 1
End If
Else
a = 0
End If
If a <> 0 Then
'copy the data into columns A to M
'You might have to adjust the ranges here
r.Value = r2.Value
End If
Next x
End Sub
where you have a source range and a target range - you appear to be putting the values in the previous row so my value of r is probably wrong in this example - you could use r.Offset(-1,0).Value = r2.Value
I'm also not sure what you are trying to do with the variable a If that is meant to be a "flag" then consider using a Boolean instead - it only has the values True or False
This is my following code that works, but I need it to paste it starting in Column C. When changing Range("A" & J + 2) to Range("C" & J + 2) it will not work then. I know its something easy but I have yet to find a specific example.
Thanks
Sub Patrick()
Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Patrick").UsedRange.Rows.Count
J = Worksheets("Sheet1").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet1").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Patrick").Range("A1:A" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Phone Call" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet1").Range("A" & J + 2)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub
xRg(K).EntireRow.Copy copies a whole row - you can't paste that anywhere but the first column.
Use something more reasonable like
xRg(K).EntireRow.Columns("A:Z").Copy
or whatever will capture the data you have on your source sheet
I am trying to identify a specific range in column-A and concatenate two cells within the specific range and delete the empty cell. I have been successful in putting a code together and it does the job very well. But, I don't know how to loop it to identify next range. Any help would be appreciated.
As per below image and code, First, I am finding and selecting a range between two (MCS) in column-A with a condition that, if the rows are more than 8 between two MCS. Then I am concatenating first 2 cells immediately after MCS and delete the empty row.
The below code works well for first range but I am unable to loop to identify next range from row 22 to 32 and perform concatenations.
I dont know how to loop in column-A and select ranges and concatenate. Any help would be much appreciated. Thanks
Sub MergeStem()
Dim findMCS1 As Long
Dim findMCS2 As Long
Dim myCount As Integer
Dim myStems As Long
Dim mySelect As Range
Dim c As Range
findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
findMCS2 = Range("A:A").Find("MCS", Range("A" & findMCS1)).Row
myCount = Range("A" & findMCS1 + 1 & ":A" & findMCS2 - 1).Cells.Count
Range("B1").Value = myCount
MsgBox "Number of rows =" & myCount
Set mySelect = Selection
If myCount > 8 Then
myStems = Range("A" & findMCS1 + 2 & ":A" & findMCS2 - 9).Select
Set mySelect = Selection
For Each c In mySelect.Cells
If firstcell = "" Then firstcell = c.Address(bRow, bCol)
sArgs = sArgs + c.Text + " "
c.Value = ""
Next
Range(firstcell).Value = sArgs
End If
Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Can you try this? Ordinarily, Find would be the way to go but because you are deleting rows it's hard to keep track of which cells you've found.
Sub x()
Dim r As Long, n1 As Long, n2 As Long
With Range("A1", Range("A" & Rows.Count).End(xlUp))
For r = .Count To 1 Step -1
If .Cells(r).Value = "MCS" Then
If n1 = 0 Then
n1 = .Cells(r).Row
Else
n2 = .Cells(r).Row
End If
If n1 > 0 And n2 > 0 Then
If n1 - n2 > 9 Then
.Cells(r + 1).Value = .Cells(r + 1).Value & .Cells(r + 2).Value
'.Cells(r + 2).EntireRow.Delete
'Call procedure to delete row
End If
n1 = n2
n2 = 0
End If
End If
Next r
End With
End Sub
I have a system which inputs a code to a cell on a spreadsheet. It does this by using a Vlookup to determine which date it is. If you look at the code below the nput is what does this Vlookup.
What I want it to do is move down a cell per amount the amount that will be in a combo box value called DayAmount. What would I need to enter for it to look at the next cell?
For example if the 5th of January is in A24 I want it to also enter the same code in the 6th and 7th of January which the Vlookup knows is A25 and A26.
Private Sub Submitplan_Click()
' This searches for the selected engineer
Dim EngineerFound As Range
Dim Front As Worksheet
Dim wb As Workbook
Dim area As Worksheet
Set wb = ThisWorkbook
Dim tabchange As String
Set Front = wb.Worksheets("Front")
x = Front.Cells(Front.Rows.Count, "F").End(xlUp).Row
With Front.Range("F8:F" & x)
Set EngineerFound = .Find(Engbox.Value, LookIn:=xlValues)
End With
EngRow = EngineerFound.Row
'This is the section which enters the data into the right date
tabchange = ("Area") & Front.Range("B8")
Set area = wb.Worksheets(tabchange)
y = WorksheetFunction.VLookup(CLng(CDate(Datebox.Value)), area.Range("A:B"), 2, 0)
nPut = WorksheetFunction.VLookup(Key, area.Range("A:B"), 2, 0) &
Hoursbox.Value
z = area.Range("C:C").Find(Engbox.Value).Row
If area.Cells(z, y).Value = " B/H" Then
area.Cells(z, y).Value = nPut & " " & "B/H"
ElseIf area.Cells(z, y).Value = " WK" Then
area.Cells(z, y).Value = nPut & " " & "WK"
Else: area.Cells(z, y).Value = nPut
End If
' If DayAmount <> "" Then
'End If
Call Update
Unload Me
End Sub
If I'm reading this correctly, you have a value in a combobox (will say DayAmount) which will be assigned until a that value is met.
Dim i as Long, j as Long, k as Long
i = ActiveCell.Row
j = DayAmount
k = 1
If j > 1 Then
Do until k = j-1
Cells(k+1,1).Value = Cells(i,1)>Value
k = i + k
Loop
End If
Or you could use a filldown, or .value match, and when you enter the line to the destination cell, you use:
Dim i as Long, j as Long
i = ActiveCell.Row
j = DayAmount
Range(Cells(i,1),Cells(i+j,1)).Value = "" 'input here
Note the arbitrary activecell and column 1 usage as i'm unsure exactly where this would be for you.
Regarding, specifically, the use of nPut, you can use offset to help, such as:
Range(nPut, nPut.Offset(DayAmount,0)) = WorksheetFunction.VLookup(Key, area.Range("A:B"), 2, 0) & Hoursbox.Value
Note that I haven't tested the latter and it's off the top of my head.
I am new to VBA and to this forum. I have a table with dates as the first column (x column) and 12 columns of data pertaining to the data (y values). I am trying to plot the data in a simple xlLine chart. Only few selected columns are to be plotted for y values. The columns are selected using a combo box at the top of the column. The number of rows are variable.
I am using this code but this is not working. Can someone kindly let me know what is wrong and fix it? Appreciate any help. Thanks in advance.
Sub drawchart1()
'
' drawchart1 Macro
'
'
Dim i As Integer
Dim j As Integer
Dim n As Integer
' finding the number of rows
j = Range("Charts!A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
' selecting some range and adding a chart which is then modified.(not sure this is the correct method.)
Range("A10:C15").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
i = 2
n = 2
' Cells (9,1) contains the value "Date". Defining the X Axis values
ActiveChart.SeriesCollection(1).Name = Sheets("Charts").Cells(9, 1).Value
ActiveChart.SeriesCollection(1).XValues = "=Charts!R10C1:R" & j & "C1"
Do While i < 14
' Cells(8,i) contain the results of combo box - true or false.
' Cells(9,i) contain the names of the series
If Cells(8, i).Value = True Then
ActiveChart.SeriesCollection(n).Name = Sheets("Charts").Cells(9, i).Value
ActiveChart.SeriesCollection(n).Values = "=Charts!R10C" & i & ":R" & j & "C" & i
n = n + 1
i = i + 1
Else
i = i + 1
End If
Loop
End Sub
Hi Again,
Since my columns would not exceed 14 (i.e. not large), I used the following "brute force" technique and it worked fine. I would still love to learn how to do it without using the "brute force" technique. Thanks in advance.
Sub drawchart()
Dim j As Integer
Dim Chartstring As String
j = Range("Charts!A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row
Chartstring = "A9:A" & j
If Cells(8, 2).Value = True Then
Chartstring = Chartstring & ", B9:B" & j
Else
Chartstring = Chartstring
End If
If Cells(8, 3).Value = True Then
Chartstring = Chartstring & ", C9:C" & j
Else
Chartstring = Chartstring
End If
' And similarly added code for each of the 14 columns
' And finally fed the chartstring into the "Source"
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=Range(Chartstring)
End Sub
Probably you're not watching any more. Here's an alternative approach.
Sub DrawChart1()
Dim i As Long
Dim j As Long
Dim ws As Worksheet
Dim rCht As Range, rYVals As Range
Dim cht As Chart
' finding the number of rows
Set ws = Worksheets("Charts")
j = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' start with X values (row 10 to j), include header row (row 9)
Set rCht = ws.Range(ws.Cells(9, 1), ws.Cells(j, 1))
' add column of Y values if row 8 of column is TRUE
For i = 2 To 14
If ws.Cells(8, i).Value Then
Set rYVals = ws.Range(ws.Cells(9, i), ws.Cells(j, i))
Set rCht = Union(rCht, rYVals)
End If
Next
' if we've had any Y values, insert chart, using range we've built up
If Not rYVals Is Nothing Then
Set cht = ws.Shapes.AddChart(xlLine).Chart
cht.SetSourceData Source:=rCht, PlotBy:=xlColumns
End If
End Sub