Problem Solved using modifications to answer
Dim i As Long, values As Range, current As Range
Set current = Range("D4") '//select 1st anchor cell
Do Until current.Value = ""
i = i + 45
Set values = Range(current.Offset(2, 0), current.Offset(45, 0)) '//select all in the ooc column
values.Copy '//got block of data here
Sheets("Sheet1").Range("A" & i).PasteSpecial
Set current = current.Offset(0, 13) '//next page
Loop
Starting in column C of an excel spreadsheet, I have pages of data 13 columns wide. I need to transfer the data in the 2nd and 3rd columns to a SQL Database, so I'm trying to move those 2 columns on each page on top of eachother for transfer.
The Screenshot below is the data im working with. I need to capture server names under ODC CSS Servers RowX CabX along with its corresponding asset tag. If i can just take those 2 columns every 13 rows and stack them I can delete the extra information on my own.
Spreadsheet http://img830.imageshack.us/img830/6126/unledoks.png
I'm sure I don't need to mention the insane amount of time this would save but I could really use some help getting started with, or using an example macro to accomplish this. I don't have much for VBA experience unfortunately, but I will work with what help I can get.
What about;
dim i As Long, values as range, current As range
set current = Range("D4") '//select 1st anchor cell
do until current.Value = ""
i = i + 1
set values = range(current.offset(1, 0), current.End(xlToRight)) '//select all in the ooc column
values.copy '//got block of data here
sheets("someothersheet").range("A" & i * 2 - 1).pastespecial
set current = current.offset(0, 13) '//next page
loop
Related
I am fairly new at VBA and I am currently trying to rework an existing macro that sums hours of a workday up by employee for the week.
I need a macro that will sum up the work hours by just a single day instead of a weekly total. There are two entries per day for each employee. Then, this total is copy and pasted into a different column.
I can not use a pivot table as this macro will be used on a different spreadsheet every week. I also can not have a reference sheet. This is going to be applied to a spreadsheet that is emailed every week, so it is constantly changing.
Basically... if the date in Column B is the same, I need the sum of hours in Column C, then that Sum is pasted over to a new column (D is fine).
Below is what the original report looks like at this point:
A B C
Joe Smith -- 03/26/2018 -- 3.65
Joe Smith -- 03/26/2018 -- 4.46
Joe Smith -- 03/27/2018 -- 5.45
Joe Smith -- 03/27/2018 -- 2.93
The existing macro is :
For Each x In n.Range(n.Range("B2"), n.Range("B" & Rows.Count).End(xlUp))
x.Value = Month(x.Value) & "/" & Day(x.Value) & "/" & Year(x.Value)
Next x
For Each x In n.Range(n.Range("J2"), n.Range("J" & Rows.Count).End(xlUp))
Set r = n.Range(x.Address)
r.Offset(0, 1).Value =
Format(Application.WorksheetFunction.Max(n.Range(n.Range("B2"), n.Range ("B" & Rows.Count).End(xlUp))), "MM/DD/YYYY")
r.Offset(0, 2).Value = Application.WorksheetFunction.SumIf(n.Range("A:A"), x.Value, n.Range("E:E"))
For I = 3 To UBound(TableHeaders)
ch = TableHeaders(I)
r.Offset(0, I).Value = Application.WorksheetFunction.SumIfs(a.Range("R:R"),
a.Range("L:L"), ch, a.Range("A:A"), x.Value)
Next I
d.RemoveAll
Next x
I can not use a pivot table as this macro will be used on a different
spreadsheet every week.
well, this is not a reason. You could run change source for pivot table any time.
This is going to be applied to a spreadsheet that is emailed every week
But at least layout of the workbooks is preserved?
The simplest way is to use formula:
=SUMIFS(C:C, A:A, A2, B:B, B2)
Paste it to D2 and drag down. You could also put formulas to A:C that just refers to proper values in source file, like:
=[WorkbookFromEmail.xlsx]Sheet1!A2
and drag it left to C and down to as many rows as you think you will need and some more. Then you could only change the name of linked file in Data/Edit Links.
As far, you don't need VBA. But you could make some macro for refreshing links to other workbook if you found manual job too troubling. This is however different story.
Alternatively, you could save the source file always under the same name, like BookFromMail.xlsx and then open the master file with formulas and refresh it.
Here's an all code way. You'll have to adjust the code to find the range you want to read and also figure out where to write to.
Sub SumEeDays()
Dim vaValues As Variant
Dim i As Long
Dim dc As Scripting.Dictionary
Dim sKey As String
'set a reference to the MS Scripting Runtime
'then you wont get an error on this line
Set dc = New Scripting.Dictionary
'Make a 2d array of the values you want process
vaValues = Sheet1.Range("a1").CurrentRegion.Value
'loop through the 2d array
For i = LBound(vaValues, 1) To UBound(vaValues, 1)
'create a unique key to keep track of ee name and date
sKey = vaValues(i, 1) & "||" & vaValues(i, 2)
If dc.Exists(sKey) Then
'If the key already exists, add the hours to what's there
dc.Item(sKey) = dc.Item(sKey) + vaValues(i, 3)
Else
'If the key doesn't exist, create it and add the hours
dc.Add sKey, vaValues(i, 3)
End If
Next i
'Loop through the dictionary of unique name/dates
For i = 1 To dc.Count
With Sheet1.Range("J1")
'Keys returns an array and Split splits it on "||"
'The 0th element of the array is the name
'The 1st element is the date
.Offset(i - 1, 0).Value = Split(dc.Keys(i - 1), "||")(0)
.Offset(i - 1, 1).Value = Split(dc.Keys(i - 1), "||")(1)
.Offset(i - 1, 2).Value = dc.Items(i - 1)
End With
Next i
End Sub
I want to be able to use my own Excel Workbook to create a pie diagram in PowerPoint. So far, I have created a VBA script to add the chart. I also changed the data sheet for the chart to look like this:
Problem
Following core problem remains:
I can't figure out, how to dynamically define the data range of the chart's data source sheet
Because the default values for the pie chart belong to these ranges, PowerPoint sets those ranges by default. If my data sheet contains more (or equal to) than 4 rows of data, it won't be that bad, as the range automatically increases. However, as shown in the example, the range doesn't adapt when there are only 3 rows of data.
What I want, would look like this: Needed (I only know how to get the data in the correct place, but not how to select it)
Related VBA code is below:
Set diaPie = pres.Slides(3).Shapes.AddChart2(2, xlPie).Chart
Set pieChartData = diaPie.ChartData
Set pieWorkbook = pieChartData.Workbook
Set pieWorksheet = pieWorkbook.Worksheets(1)
pieWorksheet.UsedRange.Clear
With dataWorksheet
id = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
a = dataWorksheet.Range("A1", dataWorksheet.Range("A1").Offset(id, 0))
b = dataWorksheet.Range("B1", dataWorksheet.Range("B1").Offset(id, 0))
pieWorksheet.Range("A2", pieWorksheet.Range("A2").Offset(id, 0)) = a
pieWorksheet.Range("B2", pieWorksheet.Range("B2").Offset(id, 0)) = b
Thanks in advance!
This should change the data range on your data sheet. maxrow is just the end of the data. So if your data is in B1:B4 then maxrow would be 4
diaPie.SeriesCollection(1).values = "Sheet1!$B$1:$B" & maxrow ' change the series range before opening and closing the workbook object
diaPie.SeriesCollection(1).XValues = "Sheet1!$A$1:$A" & maxrow 'Labels
I have been trying to learn visual basic to write code to perform tasks when working with data in excel. I have been mostly copying snippets of code I find online and piecing them together. Currently, I have folders containing 10's of thousands of .csv files (data output from a CMM).
In each of these files column A consistently contains labels for the data and column B consistently contains the CMM data.
Currently, my program allows a user to select multiple .csv files and in a long roundabout way they all end up on one worksheet in excel with the data labels in the first column and the data in the next columns.
For example, if 10 CSV files are opened the data labels would be in the first column and the data would be in the next 10 columns.
The problem is that that the data labels are not aligned with the data and often each row of data has multiple labels.
I have been able to concatenate the data labels into one label for each row of data but cannot figure out how to align this label with the row of data.
At this point, I would be happy with a separate block of code that accomplishes this but... I suspect that my block of code that concatenates the labels could be easily modified to accomplish the task, I just haven't been able to figure it out.
So my code spits this out:
(Flatness) : Item (113)
Plane:RH_5_Mating_Surface
5.012 4.014 6.313 etc...
(Z) : Item (128) / (X) : Item (135)
Circle:Offset_Dowel_Hole
1.012 2.987 5.478 etc...
Circle:Cast_Hole_From_Offset_Dowel_Hole
2.147 7.895 4.258 etc...
Then this code concatenates the labels and spits them out in column B:
Dim rng1 As Range
Dim Lastrow As Long
Dim c As Range
Dim concat As String
Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
Set rng1 = Range("A9:A" & Lastrow)
concat = ""
For Each c In rng1
If c > 0 Then
concat = concat & " " & c.Value
concat = Trim(concat)
Else
c.Offset(-1, 1).Value = concat
concat = ""
End If
Next c
The result is:
(Flatness) : Item (113) Plane:RH_5_Mating_Surface
5.012 4.014 6.313 etc...
(Z) : Item (128) / (X) : Item (135) Circle:Offset_Dowel_Hole
1.012 2.987 5.478 etc...
Circle:Cast_Hole_From_Offset_Dowel_Hole
2.147 7.895 4.258 etc...
What I need is:
I cant figure out how to show it here but...
I need the rows to match up, also note, here it shows that the data and labels are offset by the same amount but in reality they are not. So my thinking is that I need it to search for the next row containing data and put the label next to it.
I feel like I can just change this part...
Else
c.Offset(-1, 1).Value = concat
but I don't know how to do...
I tried nesting another "For Each" here instead similar to what its already doing but with a "For Each d In rng2" where "rng2" was the data column and it would look for the next row with data and place "concat" next to the data using "d.offset(-1, -1).Value = concat"
I couldn't figure out how to get it to work...
This is one possible way of doing it.
Delete the empty cells and shift up in the columns. If the data order is consistent, they should line up correctly.
For i=1 to Lastrow
If Range("A" & i).Value=""
Range("A" & i).Delete Shift:=xlUp
End If
If Range("B" & i).Value=""
Range("B" & i).Delete Shift:=xlUp
End If
Next
You can change the range according to your sheet. Also, modify the code to use another 'IF' condition to check blanks, if that works better for your case.
I have two columns with random times and the times come from two different sources so the columns do not have the same amount of data points. I want to start with the first time in the first column and compare it to each time in the second column. If there is a match in times, I would like to pull relevant data. After a match is found (if there is one) I would like for the code to go to the second cell in the first column and compare it to every value in the second column and so on.
Here is the code I have so far:
Sub TransferInfo()
'Activate the Sub to Convert and Format Dates
Call ConvertDates
'Define Variables
Dim st As Worksheet
Dim ts As Worksheet
Dim lastrow As Long
Dim i As Integer
j = 2
'Find and set the last used row
Set st = ThisWorkbook.Worksheets("Data Table")
lastrow = st.Cells(st.Rows.Count, "B").End(xlUp).Row
Set ts = ThisWorkbook.Worksheets("ShopFloor")
'Cycle through/compare Row J, Column 18 based on each cell in Row I, Column 14
For i = 2 To lastrow
Do Until IsEmpty(ts.Cells(j, 8)) Or IsEmpty(st.Cells(j, 2))
If st.Cells(i, 14).Value = ts.Cells(j, 18).Value Then
st.Cells(i, 15).Value = ts.Cells(j, 2).Value
Exit Do
Else
st.Cells(i, 15).Value = ""
End If
j = j + 1
Loop
j = 2
Next i
End Sub
The other sub that I call at the beginning of this sub simply rounds the times in each column to the nearest 15 minute interval to increase the likelihood of matches between the columns.
My question is: The code does not copy and paste any more information although there are times that match between the two columns. Why would the code that I have not work? Also, with larger data sets I am afraid that this the code may crash Excel and because I have a loop within a loop trying to process a lot of data a lot of times, but I don't know of a more efficient way to accomplish what I am trying to without this code.
If anyone has any insights as to why this code doesn't work I would greatly appreciate any help.
Thanks!
Based on your code, it looks like you just need an INDEX/MATCH formula. Use this in O2 and copy down:
=IFERROR(INDEX(B:B,MATCH(N2,R:R,0)),"")
No need for VBA
I have multiple spreadsheets that each roughly look like this:
I'm trying to find a way to go through each of the SPEAKER HEADERS in Row 1, and summarize the scores that are associated with the corresponding survey question ("Was the CONTENT good? Was the SPEAKER relevant? What the DELIVERY good?) grouped by color.
I can't think of a clever way of doing this automatically.
I can get the RANGE SPANS of the Merged Cells like this:
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
MsgBox Cell.MergeArea.Address
End If
Next
I then need to iterate over the range provided by the address, getting the numerical values in all the rows BELOW that range.
For example, running the current macro produces this:
I need to take $C$1:$E$1 and run a for loop that say FROM C1 to E1 average all the numbers in the rows below it. I have no idea how to do this.
I was thinking about augmenting the selection in include everything used
Is there a better way to do this?
This is the tragically bad way I'm doing it now (which I'm quite proud of on account of being new to excel):
For Each Cell In src_sheet.UsedRange.Cells
If Cell.Row = 1 And IsEmpty(Cell) = False Then
Set rng = Range(Cell.MergeArea.Address) 'Equal to the Address of the Merged Area
startLetter = Mid(rng.Address, 2, 1) 'Gets letter from MergeArea Address
endLetter = Mid(rng.Address, 7, 1) 'Gets letter from MergeArea Address
On Error GoTo ErrHandler:
Set superRange = Range(startLetter & ":" & endLetter)
ErrHandler:
endLetter = startLetter
Set superRange = Range(startLetter & ":" & endLetter)
Resume Next
superRange.Select
MsgBox Application.Average(Selection)
In order to get rid of the error you are having, you need to change:
Set rng = Cell.MergeArea.Address
to
Set rng = Range(Cell.MergeArea.Address)
Ideally, this data would be better stored in a database so that it could be queried easily. If that's not an option, then the way you are going at it in Excel is as valid as most any other approach.
EDIT
Once you obtain the address of the left-most column for each of your speakers, you can loop through each column to obtain averages.
'Number of columns in the current speaker's range.
numColumns = rng.Columns.Count
'First row containing data.
currentRow = 4
'First column containing data.
firstColumn = rng.Column
'Loop through each column.
For col = firstColumn to firstColumn + (numColumns -1)
totalValue = 0
'Loop through each row.
Do While Cells(currentRow,col).value <> ""
totalValue = totalValue + Cells(currentRow,col).Value
currentRow = currentRow + 1
Loop
averageValue = totalValue / (currentRow - 3)
'Reset the currentRow value to the top of the data area.
currentRow = 4
'Do something with this average value before moving on to the next column.
Next
If you don't know what row is the start of your data, you can keep checking every row below rng.Row until you hit a numeric value.
The method above assumes that you have no blank entries in your data area. If you have blank entries, then you should either sort the data prior to running this code, or you would need to know how many rows you must check for data values.