I have an excel 2007 sheet where column names with data are all placed in one single column and I need to shift one column name to the left or right with data so that I can have separate columns. Can you create a VBA function where it reads all rows of the column and shift those columns with certain keywords. Such as:
A1 B1
1 **Category1**
Cat1 info here
**cf**
45
34
34
Sf
542
234
234
2 **Category2**
Cat2 info here
**cf**
76
23
67
**Sf**
678
987
3476
I Need to move "cf" column + data to a different column and paste it to its relevant category. So "cf" would shift right with data and move up along with its category. I would then delete the empty rows of B Column.
Finally had it figured out, Bad coding maybe but it works.. :)
Thanks All for your Help .
Sub test()
Dim i As Long
Dim toprow As Long
Dim z As Long
Dim count As Long
Dim b As Long
toprow = 3
b = toprow
For i = toprow To Cells(Rows.count, 1).End(xlUp).Row
If Not Cells(i, 1) = "" And Not Cells(i, 2) = "" Then
b = i
count = 0
z = i
End If
If Cells(i, 1) = "" Then
If Cells(i + 1, 1) = "" Then
z = i
If Not Cells(z + 1, 2) = "" Then
Cells(z + 1, 2).Cut Cells(b, 2)
i = b
b = z + 1
count = 0
ElseIf count = 0 Then
count = z
b = count
End If
End If
End If
Next i
End Sub
Related
Hi I am trying to compare two sets of data by having indicators if they increased, decreased, or stayed the same. I was able to get it working on one column. My problem is I can't loop it on multiple columns.
Basically:
If A1 = C1 then D1.Value = 0
If A1 > C1 then D1.Value = 1
If A1 < C1 then D1.Value = 2
I've tried to do the "do while" to add increments on the columns but it did not work.
Sub ChangeIndicator2()
Dim i As Long
Dim a As Long
Dim b As Long
Dim x As Long
Dim y As Long
Dim ProgramCount As Long
i = 2
a = 8
b = 2
x = 0
y = 8
ProgramCount = 12
Do While y <= ProgramCount
For Each c In Worksheets("Sheet1").Range("A2:A20").Offset(x, y)
If Worksheets("Sheet1").Cells(i, a).Value = Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 0
ElseIf Worksheets("Sheet1").Cells(i, a).Value < Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 1
ElseIf Worksheets("Sheet1").Cells(i, a).Value > Worksheets("Sheet1").Cells(i, b).Value Then
c.Value = 2
End If
i = i + 1
Next c
a = a + 2
b = b + 2
y = y + 2
Loop
End Sub
Only the first column works, the second column only shows 0 values.
So basically, what you want to do is compare 2 columns which are 2 columns apart and repeat that on another pair of columns which is 8 columns from the first column. If my assumption is correct then have a go at this:
For i = 0 To (ProgramCount * 8) Step 8
With Worksheets("Sheet1").Range("A2:A20").Offset(, i + 3)
.FormulaR1C1 = "=IF(RC[-3]=RC[-1],0,IF(RC[-3]>RC[-1],1,2))"
.Value2 = .Value2
End With
Next
Adjust the offset to suit your needs (I may have misunderstood the actual columns you target to update). Hope this helps.
I am trying to add values from different sheets (Sheet 2 to 5) into my main sheet (Sheet 1). In Sheet 1 I want the cells to contain the right formula pointing to the different sheets (if possible).
Typically like this:
='Sheet2'!D5+'Sheet3'!D165
All my sheets have different products, but some sheets contain same products. So I want to search through them all and ADD them in my Main Sheet (Sheet 1).
Sub UpdateMainSheet()
' Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Count As Integer
'Line of code to delete old data in Main Sheet:
Worksheets("Sheet1").Range("A2:H10000").Clear
AktivtArkOverskrift = "List of Articles from Sheet 2 to 5"
'Creates Headline in Main Sheet:
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Sheet1").Cells(eRow, 1) = AktivtArkOverskrift
Worksheets("Sheet1").Cells(eRow, 1).Font.Bold = True
'Script to check and gather data from the other sheets (Sheet 2, 3, 4 and 5):
For K = 2 To 5
'For loop to check each line in sheet "K"
For I = 2 To 1000
'If function to check if the cell I in column F is empty, if so it_jumps to next row and do the same check:
If Worksheets(K).Cells(I, 6) > 0 Then
Count = 0
'For loop to check if I already have a row in the Main Sheet with the article I'm checking:
For L = 2 To 1000
'If function to check if the articles have the same article number:
If Worksheets(K).Cells(I, 1) = Worksheets("Sheet1").Cells(L, 1) Then
'Line of code that are supposed to ADD the values that is currently in the Main Sheet, togheter with the value in Sheet K:
Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
End If
Next L
End If
Next I
Next K
End Sub
So what I need to fix in my code is this part (located furthest inside the For Loop):
Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
And make it create a formula in the wanted cell, that looks something like this:
='Sheet2'!D5+'Sheet3'!D165
It must be able to add another cell as well, since the Loop are running through several Sheets (Sheet 2 to 5) that may contain the same products.
I.e. I only want one line in my Main Sheet for each product.
I managed to find the solution in the end.
It seemed I had switched the L and I in som of the looping, which resulted in the values not to be added togheter.
The following code (I did not translate to English, but can do this if someone wants/need it) solved my issue, and gave me the values from Sheet 2 to 5 sorted by product in Sheet 1:
Sub OppdaterePlukkelisteSummert()
'Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Teller As Integer
Dim value1 As Integer
Dim value2 As Integer
'Sletter Plukklisten for å oppdatere og sortere på nytt:
Worksheets(1).Range("A2:H10000").Clear
'HENTING AV DATA FRA ARKET "K":
AktivtArk = "Artikler Summert fra Alle Ark"
AktivtArkOverskrift = "Artikler Summert fra Alle Ark"
'Setter inn Overskrift som Forteller kva ark utstyret kommer fra:
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets(1).Cells(eRow, 1) = AktivtArkOverskrift
Worksheets(1).Cells(eRow, 1).Font.Bold = True
'Sjekker hvilke/hvilket rader/utstyr som skal plukkes, og legger det inn i "Ark1":
For K = 2 To 5
For I = 2 To 1000
If Worksheets(K).Cells(I, 6) > 0 Then
Teller = 0
For L = 2 To 1000
If Worksheets(K).Cells(I, 1) = Worksheets(1).Cells(L, 1) Then
value1 = Worksheets(1).Cells(L, 4)
value2 = Worksheets(K).Cells(I, 4)
Worksheets(1).Cells(L, 4) = value1 + value2
Worksheets(1).Cells(L, 6) = value1 + value2
Else
Teller = Teller + 1
End If
Next L
If Teller > 998 Then
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For J = 1 To 11
Worksheets(1).Cells(eRow, J) = Worksheets(K).Cells(I, J)
Next J
Worksheets(1).Cells(eRow, 6).Font.Color = RGB(0, 150, 0)
Worksheets(1).Cells(eRow, 7).Font.Color = RGB(0, 150, 0)
End If
End If
Next I
Next K
Worksheets(1).Range("A2").Select
End Sub
I hope this can be useful for someone else :-)
All help and suggestion in the comments are appreciated!
I was going to illustrate with this simple example:
I = 1 'for example
For K = 2 To 5
Worksheets("Sheet1").Cells(I, 4).Value = Worksheets("Sheet1").Cells(I, 4).Value + _
WorksheetFunction.SumIf(Worksheets(K).Range("A:A"), "Bananas", Worksheets(K).Range("D:D"))
Next K
The function is designed to take in input - variable pg - that is in a cell on the spreadsheet, go through the rows of data to see which row in a column 1 matches variable pg. Once the match is found, it then goes through the columns to see which of the columns has "VRP23" Or "VRP24" in the first row. When that is found, it takes the number of the matching row/column and performs the "step1" modification. The issue is that in the spreadsheet the error #VALUE! appears and I'm not sure why this is.
Function getECONpgdimscore1(pg As String) As Double
Dim row As Integer
row = 2
Dim c As Integer
c = 1
Dim econ As Double
econ = 0
Dim x As Integer
Dim NumRows As Integer
NumRows = Range("A2", Range("A2").End(xlDown)).rows.count
Cells(row, 1).Select
For x = 1 To NumRows
If Cells(row, 1).Value = pg Then
Do While c < 48
Cells(row, 7 + c).Select
If Cells(1, 7 + c).Value = ("VRP23" Or "VRP24") Then
econ = econ + step1(Cells(1, 7 + c), Cells(row, 7 + c))
End If
c = c + 1
Loop
End If
row = row + 1
Next x
getECONpgdimscore1 = (econ / 100) * 2.5
End Function
I have data in a sheet which looks like
A B C D
1001 1002 1003
Phone 1 1 1
TV 1 1
Remote 1
AC 1 1 1
I want a macro to which gives Data in another sheet something like
Phone 1001;1002;1003
TV 1001;1003
Remote 1003
AC 1001;1002;1003
in 2 columns
This is Sample data, the columns and rows vary every time to large numbers say up to 1000.
So I need a macro to get the data from first row, only if corresponding cell has "1" in it.
This might help ..
Sub Init()
Dim x, y As Integer
Dim s As String
Dim xt As Worksheet
Set xt = Sheets("Sheet2")'----------> you may change this
For y = 2 To 6 '--------------------tv,remote,etc
s = ""
For x = 2 To 4 '------------------1001,1002,1003
If Cells(y, x) = 1 Then
If Len(s) > 0 Then s = s & "; "
s = s & Cells(1, x)
End If
Next
xt.Cells(y, 1) = Cells(y, 1)
xt.Cells(y, 2) = s
Next
End Sub
I need some help converting three colums into a matrix using excel macro.
Here is an example:
From this:
A A 0
A B 23
A C 3
B A 7
B B 56
B C 33
C A 31
C B 6
C C 5
to this:
A B C
A 0 23 3
B 7 56 33
C 31 6 5
Hope you can help me.
Thanks
Not quite sure what exactly you are meaning by matrix. For the code below I assumed you were looking for a way to read the data in the first two columns as Row and Column data of the output table. Assume the input data is in the Columns 1 - 3 of "Sheet1"
Sub ConvertTableOfData()
Dim testArray(1 to 3)
Dim chkROW as Integer
Dim chkCOL as Integer
Dim chkVAL as Integer
'// index the Row and Column headers
testArray(1) = "A"
testArray(2) = "B"
testArray(3) = "C"
'// Iterate through every row in the initial dataset
For i = 1 to Worksheets("Sheet1").Cells(1, 1).End(xlDown).Row
With Worksheets("Sheet1")
'// Assign the Output Row and Column values
'// based on the array indices
For j = 1 to UBound(testArray, 1)
If .Cells(i, 1) = testArray(j) Then
chkROW = j
End If
If .Cells(i, 2) = testArray(j) Then
chkCOL = j
End If
Next j
'// store the actual value
chkVAL = .Cells(i, 3)
End With
'// output table (in Sheet2)
With Worksheets("Sheet2")
.Cells(chkROW, chkCOL) = chkVAL
End With
Next i
'// Add headers to Output table
For i = 1 to 3
With Worksheets("Sheet2")
.Cells(i + 1, 1) = testArray(i)
.Cells(i, i + 1) = testArray(i)
End With
Next i
End Sub
You can also perform this without VBA.
Assume your table of data is in the range A1:C9.
Assume the first number (0) in the 3 by 3 grid of data is cell F3, with A, B, C in the row above, and A, B, C in the column to the left.
Enter the formula in cell F3 as
=INDEX($C$1:$C$9,SUMPRODUCT(--($A$1:$A$9=$E3),--($B$1:$B$9=F$2),ROW($A$1:$A$9)))
Copy this formula to all 9 cells in the 3 by 3 grid.
This generalized to any size of data.