I have a question about Excel.
I have a sheet with some columns, like:
A B C
------------------------
1 test 1
2 test 5
3 test 5
4 test 2
4 test 6
5 test 7
6 test 8
7 test 2
8 test 3
9 test 3
9 test 1
9 test 4
10 test 5
I would like a macro that does the following. It checks C. If value of C is lower than 3, copy that row and all the following rows with the same value in A, until A changes, to a new sheet, Then check C again and so on.
Output here should be:
A new sheet with
a b c
4 test 2
4 test 6
7 test 2
9 test 1
9 test 4
Can anyone please help me with that?
Think I've found it (haven t really tested it yet)
Sub CustomcCopy()
Dim controleValue As Double
controleValue = 3
Dim AValue As String
Dim lastline As Integer, tocopy As Integer
lastline = Range("F65536").End(xlUp).Row
j = 1
For i = 1 To lastline
For Each c In Range("L" & i)
If (c < controleValue And c > 0) Then
tocopy = 1
End If
Next c
If tocopy = 1 Then
AValue = Cells(i, "A").Value
Do While Cells(i, "A").Value = AValue
Rows(i).Copy Destination:=Sheets(2).Rows(j)
j = j + 1
i = i + 1
Loop
End If
tocopy = 0
Next i
End Sub
Related
I'm trying to learn how to do count-sorting in excel-vba using arrays. I'm having some issue with the final step of actually doing the count sort (v1Sort and V2 Sort columns). This is the table so far
V1 V2 Bin V1Count PointerV1 V2Count PointerV2 V1Sort V2Sort
6 3 -1 2 2 1 1 ? ?
7 2 0 3 5 4 5
1 6 1 4 9 4 9
5 3 2 5 14 5 14
6 0 3 2 16 2 16
9 7 4 4 20 2 18
7 9 5 4 24 4 22
8 6 6 2 26 4 26
2 4 7 4 30 1 27
8 3 8 1 31 2 29
4 2 9 0 31 2 31
1 3 10
2 6
0 10
1 5
8 7
5 9
5 10
5 1
6 7
3 2
8 5
0 6
2 8
3 1
2 3
4 4
3 1
3 7
3 1
6 2
Here's my code so far without actually doing the final step of the count sort. I understand the concept fully but am finding it hard to use arrays to do the count sort.
Sub Count_Sorting()
Const iOffData As Integer = 1
Const iOffPoint As Integer = 2
Const iOffPoint_2 As Integer = 3
Dim iBin As Integer
Dim iData As Integer
Dim iPointerVector_1() As Integer
Dim iPointerVector_2() As Integer
Dim iPoint As Integer
Dim iRow As Integer
Dim iDataVector_1(32) As Integer
Dim iDataVector_2(32) As Integer
Dim iSortVector_1(1 To 50) As Integer
Dim iSortVector_2(1 To 50) As Integer
Application.ScreenUpdating = True
Sheets("Sheet1").Range(Cells(1, 3), Cells(50, 8)).Clear
ReDim iPointerVector_1(-1 To 11)
ReDim iPointerVector_2(-1 To 11)
Sheets("sheet1").Cells(1, 1).Value = "V1"
Sheets("sheet1").Cells(1, 2).Value = "V2"
Sheets("sheet1").Cells(1, 3).Value = "Bin"
Sheets("sheet1").Cells(1, 4).Value = "V1Count"
Sheets("sheet1").Cells(1, 5).Value = "PointerV1"
Sheets("sheet1").Cells(1, 6).Value = "V2Count"
Sheets("sheet1").Cells(1, 7).Value = "PointerV2"
'Write bin numbers.
For iRow = 2 To 13
Sheets("Sheet1").Cells(iRow, 3).Value = iRow - iOffPoint_2
Next iRow
'Read the values from Sheet1.
For iRow = 2 To 32
iDataVector_1(iRow) = Sheets("Sheet1").Cells(iRow, 1).Value
iDataVector_2(iRow) = Sheets("Sheet1").Cells(iRow, 2).Value
Next iRow
'************************************************************
'First we do the procedure for sorting Vector 1
'************************************************************
'Count the number of data points in each bin for Vector 1 .
For iRow = 2 To 32
iPointerVector_1(iDataVector_1(iRow)) = iPointerVector_1(iDataVector_1(iRow)) + 1
Next iRow
For iBin = 0 To 10
Sheets("Sheet1").Cells(iBin + iOffPoint, 4).Value = iPointerVector_1(iBin)
Next iBin
'Get cumulative counts, located in prior bins, in preparation for later
're-reading of the data and decrementing of the pointers for Vector 1.
For iBin = 0 To 10
iPointerVector_1(iBin) = iPointerVector_1(iBin - 1) + iPointerVector_1(iBin)
Next iBin
For iBin = 0 To 10
Sheets("SHeet1").Cells(iBin + iOffPoint, 5).Value = iPointerVector_1(iBin)
Next iBin
'
'************************************************************
'Now we do the procedure for sorting Vector 2
'************************************************************
'Count the number of data points in each bin for Vector 2.
For iRow = 2 To 32
iPointerVector_2(iDataVector_2(iRow)) = iPointerVector_2(iDataVector_2(iRow)) + 1
Next iRow
For iBin = 0 To 10
Sheets("SHeet1").Cells(iBin + iOffPoint, 6).Value = iPointerVector_2(iBin)
Next iBin
'Get cumulative counts, located in prior bins, in preparation for later
're-reading of the data and decrementing of the pointers for Vector 2.
For iBin = 0 To 10
iPointerVector_2(iBin) = iPointerVector_2(iBin - 1) + iPointerVector_2(iBin)
Next iBin
For iBin = 0 To 10
Sheets("SHeet1").Cells(iBin + iOffPoint, 7).Value = iPointerVector_2(iBin)
Next iBin
```End Sub
You indeed get the idea about count sorting. What makes your implementation difficult is the way you organize your code. Probably the first thing to do is to define a CountSort() function which takes as input an array of values, and returns an array of the same values sorted. Now, I see that you want to output the contents of intermediate arrays used in the count sort function to cells of Sheet1. So, you could pass to the CountSort() function the row and column indexes where to output intermediate arrays. So, your function could look like this:
' Returns array of the values sorted.
Public Function CountSort(values() As Integer, rowIndex As Integer, columnIndex As Integer) As Integer()
End Function
To output the contents of an array to Sheet1 you can define a routine like:
' Print contents of array values in column columnIndex, starting at rowIndex going downwards.
Sub PrintArray(values() As Integer, rowIndex As Integer, columnIndex As Integer)
Dim i As Integer
For i = 0 To UBound(values) - LBound(values)
Sheets("Sheet1").Cells(rowIndex + i, columnIndex).Value = values(LBound(values) + i)
Next
End Sub
And the CountSort() function would look like:
' Returns array of the values sorted.
Public Function CountSort(values() As Integer, rowIndex As Integer, columnIndex As Integer) As Integer()
' Assuming values are in range [0 10].
Dim bin(0 To 10) As Integer
Dim i As Integer
' Initialize bin to 0.
For i = LBound(bin) To UBound(bin)
bin(i) = 0
Next
PrintArray values, rowIndex, columnIndex
' Count number of occurrences of each value.
For i = LBound(values) To UBound(values)
bin(values(i)) = bin(values(i)) + 1
Next
PrintArray bin, rowIndex, columnIndex + 1
' Find cumulative frequency.
For i = LBound(bin) + 1 To UBound(bin)
bin(i) = bin(i) + bin(i - 1)
Next
PrintArray bin, rowIndex, columnIndex + 2
' Build sorted array.
Dim sorted() As Integer
ReDim sorted(LBound(values) To UBound(values)) As Integer
For i = UBound(values) To LBound(values) Step -1
sorted(bin(values(i))) = values(i)
bin(values(i)) = bin(values(i)) - 1
Next
PrintArray sorted, rowIndex, columnIndex + 3
' Return sorted array.
CountSort = sorted
End Function
In VBA, it is always a good idea to use the LBound() and UBound() functions as they make your code independent of how arrays have been declared index-wise.
Is there a simpler way in excel to achieve this; numbers 1 - 20 in column A, 21-40 in column C, 41-60 in column E and so on.
A B C D E
1 6 11
2 7 12
3 8 13
4 9 14
5 10 15
Any assistance is highly appreciated
I'm not sure what you are doing, but this little subroutine will do what you need it to do... I think:
Sub makenumbers()
Dim intCol As Integer, intRow As Integer, intCounter As Integer
intCol = 1
intCounter = 1
For intCol = 1 To 40 Step 2
For intRow = 1 To 20
Sheet1.Cells(intRow, intCol).Value = intCounter
intCounter = intCounter + 1
Next intRow
Next intCol
End Sub
Just change that for intcol = 1 to 40 step 2 to whatever your last column is supposed to be.
I am looking to loop through Column A.
- If the next number is greater than the previous number continue (A: 0,1,2,3..).
- Do this until the next number is equal or less than (A: 0,1,2,3,4,4..).
- If number is less than(A: 0,1,2,3,4,3..). or equal, take the highest # 4 subtract lowest #0, and put the results in columnB next to the highest number.
- If the next number is equal the previous number, subtract and put the answer 0 in columnB.
- If the next number is lower than the previous number continue. Do this until the next number is equal or less than.
- If number is less than or equal, take the highest # 4 subtract lowest #0...
I am not sure If I am clear but I am thinking a loop might work for this situation. Or perhaps any other idea would be greatly appreciated. Thanks in advance.
A B
1 0
2 1
3 2
4 3
5 4 4
6 4 0
7 3
8 2
9 1
10 0 4
11 1
12 2 2
13 2 0
14 3
15 4 2
... ...
You can use dictionary... adding the row number to the key value and check the positions...
Sub YourLoop()
Dim dic As Scripting.Dictionary
Set dic = New Scripting.Dictionary
Dim i As Integer
Dim n As Integer
For i = 1 To Rows.Count
''ColumnA values
dic.Add i, Cells(i, 1).Value
Next i
Dim k1 As Integer
Dim k2 As Integer
Dim k3 As Integer
Dim k4 As Integer
Dim v1 As Integer
Dim v2 As Integer
Dim v3 As Integer
Dim v4 As Integer
Dim v As Integer
Dim c As Integer
c = 1
For Each key In dic.Keys
v = dic(key)
If c = 1 Then
''do nothing
ElseIf c = 2 Then
k1 = key - 1
v1 = dic(k1)
If v <= v1 Then
End If
ElseIf c = 3 Then
k2 = key - 2
k1 = key - 1
v1 = dic(k1)
v2 = dic(k2)
ElseIf c >= 4 And c < dic.Count Then
k4 = key - 4
k3 = key - 3
k2 = key - 2
k1 = key - 1
v1 = dic(k1)
v2 = dic(k2)
v3 = dic(k3)
v4 = dic(k4)
ElseIf c = dic.Count Then
End If
c = c + 1
Next
I have a several text separated by ;
A
1;2;3;5;6;7;8;9;10
11;12;13;14;15;16;17
18;19;20;21
Column A has few text in each row 1,2,3 and so on separated by ';'
With the help of 'Text to Column' Option in 'Data' tab we are able to separate the same
Which will look something like this
A B C D E F G H I
1 2 3 5 6 7 8 9 10
11 12 13 14 15 16 17
18 19 20 21
Now we have to manually copy all text and shift the same to same column
A
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Numbers shown are already example, it can be any text string.
We are doing manually and it takes lot of time as there are more than 100's of entry.
Is there any way to automate the same with the help of macro? Have been googling and trying but not yet successful.
You can do this by some VBA source code:
Add a button on your sheet
Double click on it
Add the following code:
Private Sub CommandButton1_Click()
Dim Counter As Integer
Counter = 1
Dim curString As String
Dim whereComma As Integer
Dim i As Integer
For i = 1 To 10
curString = Cells(i, 1)
whereComma = InStr(1, curString, ";", vbTextCompare)
While InStr(whereComma, curString, ";", vbTextCompare) > 0
Cells(Counter, 4) = Left(curString, whereComma - 1)
Counter = Counter + 1
curString = Right(curString, Len(curString) - whereComma)
Wend
Cells(Counter, 4) = curString
Counter = Counter + 1
Next I
End Sub
End Sub
Click on button
You can see your result on column D
This VBA will do what you want and output to column B:
Sub TransposeColumnA()
Dim X As Long
For X = 1 To Range("A" & Rows.Count).End(xlUp).Row
Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1).Resize(UBound(Split(Range("A" & X).Text, ";")) + 1, 1).Formula = Application.Transpose(Split(Range("A" & X).Text, ";"))
Next
End Sub
I have an excel sheet with the following format
a 2 3 4 0 0 0 0 0
a 2 5 6 7 0 0 0 0
a 4 5 9 0 0 0 0 0
b 5 5 9 0 0 0 0 0
b 1 1 1 1 1 1 1 1
I want to end up with something like this
a 2
a 3
a 4
a 2
a 5
a 6
a 7
a 4 .....
b 1
b 1
b 1 ....
Check out my unpivot add-in (just add a header row that you can remove afterwards). It will return the data in the format you need.
Try this
Sub move()
Dim cell As Range, _
found As Range
Dim letter As String
Set cell = Range("B1")
Set found = Range("A:A").Find("*", Range("A1"), searchdirection:=xlPrevious).Offset(2, 0)
Do While (cell.Value <> "")
letter = cell.Offset(0, -1).Value
Do While (cell.Value <> 0)
found.Value = letter
found.Offset(0, 1).Value = cell.Value
Set cell = cell.Offset(0, 1)
Set found = found.Offset(1, 0)
Loop
Set cell = Cells(cell.Row + 1, 2)
Loop
End Sub
I was able to do this pretty quickly with a combination of concatenation and de-concatenation and a formula from http://www.cpearson.com/excel/TableToColumn.aspx
=$A1&","&B1
=OFFSET($K$1:$R$5,TRUNC((ROW()-ROW($U$1))/COLUMNS($K$1:$R$5),0),MOD(ROW()-ROW($U$1),COLUMNS($K$1:$R$5)),1,1)
=LEFT(U1,FIND(",",U1,1)-1)
=RIGHT(U1,FIND(",",U1,1)-1)
Good Luck.