Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 1 year ago.
Improve this question
Can someone suggest me how to transepose every nth row to multiple column using VBA.
i have data similar to this about 10000 rows (every transpose row need to do after '##')
dataset
|-|
|-|
|##|
|text1|
|text2|
|text3|
|text4|
|##|
|text5|
| text6
| text7
| ##
| text8
| text9
| text10
| text11
| ##
| Text12
| text13
| ...
result (using ' | ' for seperate each column in excel [ A | B | C | D...])
-
-
-
-
-
##
text1
text2
text3
text4
##
text5
text6
text7
##
text8
text9
text10
text11
##
text12
text13
...
Try this code
Sub Test()
Dim a, i As Long, m As Long, k As Long, mx As Long
a = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 100)
i = 1
Do Until a(i, 1) = "##" And i >= UBound(a, 1)
If a(i, 1) = "##" Then m = m + 1: k = 1
b(m, k) = a(i, 1)
If mx < k Then mx = k
k = k + 1
If i = UBound(a, 1) Then Exit Do
i = i + 1
Loop
Range("D1").Resize(m, mx).Value = b
End Sub
Related
I want to get the total count from the condition for loop, Let's say for the first row(I), the code will check through the if condition, if the condition meets the specific month then use the specific for loop to get the column count (for example : if the row's month is 1 then apply For k As Integer = 4 To dt.Columns.Count - 1 to get the count, if the row's month is 2 then apply For k As Integer = 4 To dt.Columns.Count - 2 to get the count and etc) follow by second row(I) and so on, after the if else condition k then return the total count ,how can i achieve it?
I have tried the method below but my code below did not work as what had been described above, it only return the count for the first condition,Please guide me on this :
For I As Integer = 0 To dt.Rows.Count - 1
'If dt.Rows(I).Item("Month").ToString = "1" Or dt.Rows(I).Item("Month").ToString = "3" Or dt.Rows(I).Item("Month").ToString = "5" Or dt.Rows(I).Item("Month").ToString = "7" Or dt.Rows(I).Item("Month").ToString = "8" Or dt.Rows(I).Item("Month").ToString = "10" Or dt.Rows(I).Item("Month").ToString = "12" Then
For k As Integer = 4 To dt.Columns.Count - 1
If dt.Rows(I).Item(k).ToString() = "1" Then
count1 += 1
Else
count1 = 0
End If
If count1 > 13 Then
Dx = True
End If
Next k
'ElseIf dt.Rows(I).Item("Month").ToString() = "2" Or dt.Rows(I).Item("Month").ToString() = "4" Or dt.Rows(I).Item("Month").ToString() = "6" Or dt.Rows(I).Item("Month").ToString() = "9" Or dt.Rows(I).Item("Month").ToString() = "11" Then
'For k As Integer = 4 To dt.Columns.Count - 2
'If dt.Rows(I).Item(k).ToString() = "1" Then
' count1 += 1
'Else
' count1 = 0
'End If
' If total > 13 Then
' Dx = True
' End If
'Next k
'End If
Next I
DataTable (column represents the date, month 11 has 30 columns and month 12 has 31 columns)
----------------------------------------------------------------------------
Id | year | month | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | till 31
----------------------------------------------------------------------------
kek | 2019 | 10 | 1 | 0 | 0 | 1 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 1 |
kek | 2019 | 11 | 1 | 0 | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 1 | 1 | 1 |
kek | 2019 | 12 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 0 |
link
Expected Output :
if the consecutive count from 11/11 till 12/12 is more than 13 then dx return true.
In your current code you're resetting count1 to zero in each Else.
Also this code:
total += count1
If total > 13 Then
Dx = True
End If
...looks like it should be outside the loop.
It seems to me that you need this:
For I As Integer = 0 To dt.Rows.Count - 1
Dim offset = 2
If {"1", "3", "5", "7", "8", "10", "12"}.Contains(dt.Rows(I).Item("Month").ToString())
offset = 1
End If
For k As Integer = 4 To dt.Columns.Count - offset
If dt.Rows(I).Item(k).ToString() = "1" Then
count1 += 1
End If
Next
Next
If count1 > 13 Then
Dx = True
End If
If you want to get fancier then try LINQ:
Dim query = _
From dr In dt.Rows.OfType(Of DataRow)()
Let offset = If({"1", "3", "5", "7", "8", "10", "12"}.Contains(dr.Item("Month").ToString()), 0, 1)
From k In Enumerable.Range(4, dt.Columns.Count - offset)
Where dr.Item(k).ToString() = "1"
Select 1
Dim total = query.Sum()
If total > 13 Then
Dx = True
End If
I'm needing to take one array (firstArray) and input into a second array (secondArray). However, the first four fields are the same value. After the first four positions, it begins to alternate in values.
Example:
firstArray
+---------+
| ID# |
| Name |
| month1 |
| month2 |
| month3 |
| etc... |
+---------+
secondArray
+----------+
| ID# |
| Name |
| month1 |
| month2 |
| NewField |
| month3 |
| NewField |
| month4 |
| etc... |
+----------+
I'm fairly new to VBA, so I apologize for the awful code.
Code so far:
Dim i As Integer
i = 0
Dim j As Integer
ReDim secondArray(0 To (fieldCount - 4) * 2)
Dim finalCountDown As Integer
finalCountDown = (fieldCount - 4) * 2
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
j = 3
Do Until i > finalCountDown
i = i + 1
secondArray(i) = "NewField"
i = i + 1
j = j + 1
secondArray(i) = firstArray(j)
Loop
I also have a MsgBox to iterate through and output my fields:
'//------ testing output
i = 0
For i = 0 To finalCountDown
MsgBox secondArray(i)
Next i
I appreciate any help! If there's any confusion, I'll gladly try to explain some more!
EDIT:
The two arrays are of different size but are dynamic. firstArray is firstly set to 20 positions while secondArray is originally set to 32 positions. (These are calculated each time this process is ran with the archived data being pulled. This allows my users to add data and not have to worry about having to manually add in the values to my arrays.)
EDIT2:
I've added Erik's portion to my code with a few alterations. I also added a separate counter for my firstArray in order to make sure it's inputting the correct rows into the correct positions of my secondArray.
EDIT3:
Here is the code that ended up working for me:
Dim i As Integer
i = 0
Dim j As Integer
'removed the " - 4"
ReDim secondArray(0 To (fieldCount * 2))
Dim finalCountDown As Integer
'removed the " - 4"
finalCountDown = (fieldCount * 2)
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
'created own counter for firstArray
j = 3
Do Until i > finalCountDown
i = i + 1
secondArray(i) = "NewField"
i = i + 1
j = j + 1
secondArray(i) = firstArray(j)
Loop
The error I was getting was due "Subscript not in Range" due to the fact that my finalCountDown variable was less than my array needed to be. Allowing the variable to become larger than my array allowed my array to finish iterating through itself and now inputs the proper fields in the proper order.
I'm accepting Erik's answer as it was the stepping stone to answering the question!
For the adjusted code, you can do a simple check to check if the j value is valid:
Dim i As Integer
i = 0
Dim j As Integer
ReDim secondArray(0 To (fieldCount - 4) * 2)
Dim finalCountDown As Integer
finalCountDown = (fieldCount - 4) * 2
secondArray(0) = firstArray(0)
secondArray(1) = firstArray(1)
secondArray(2) = firstArray(2)
secondArray(3) = firstArray(3)
i = 3
j = 3
Do Until i > finalCountDown
i = i + 1
finalArray(i) = "NewField"
i = i + 1
j = j + 1
If j => LBound(colheaders) And j <= UBound(colHeaders) Then
finalArray(i) = colHeaders(j)
End If
Loop
Closed. This question does not meet Stack Overflow guidelines. It is not currently accepting answers.
This question does not appear to be about programming within the scope defined in the help center.
Closed 5 years ago.
Improve this question
This question been asked in last year exams. I don't think it will gonna give output due to <> this statement. What's your thoughts?
Dim sum As Integer, k As Integer
sum = 0
k = 5
Do While k <> 0
sum = sum + k * k
MsgBox "sum" & sum
k = k - 1
Loop
Yes, it will give output of 55. It will loop from k=5 to k=1 and sum will be incremented with the result of k*k in each loop:
sum = 0 + 5 * 5 = 25
sum = 25 + 4 * 4 = 41
sum = 41 + 3 * 3 = 50
sum = 50 + 2 * 2 = 54
sum = 54 + 1 * 1 = 55
To be precise, there will be no output at all, but there will be five popup messages reading:
sum25
sum41
sum50
sum54
sum55
Write:
Sub test()
Dim sum As Integer, k As Integer
sum = 0
k = 5
Do While k <> 0
sum = sum + k * k
Debug.Print "K" & k & " - " & "sum" & sum
k = k - 1
Loop
End Sub
The output is:
K5 - sum25
K4 - sum41
K3 - sum50
K2 - sum54
K1 - sum55
Shown in Immediate window (Ctrl + I)
The output will be your program will be
sum25
sum41
sum50
sum54
sum55
I have raw data I'm trying to sort out by date, the data is in this form:
month:april-2014
offer | value
ofr x | 2132
ofr y | 135
.
.
.
month:mai-2014
offer | value
ofr x | 5115
ofr z | 513
ofr y | 651
and it goes on, there are offers that apear every month and others that dissapear.
I wanted it to look like this :
offer | april-2014 |mai 14 | june ....
ofr x 123 5 6
ofr y 5 1 6
ofr z
ofr a
.
.
any help would be appreciated, thank you
Try to restructure the data like this and use pivot tables?
Date | offer | value
may-2014 |ofr x | 5115
may-2014 |ofr z | 513
may-2014 |ofr y | 651
This first chunk of code is going through and rearranging things for you. The other important thing it does is only sends one column from your selected range to the function. Some important things to remember are you may need to write the search criteria if you key word for "month" is not in the same spot in the text, the word offer is not by itself with no spaces in the following row. Another point of note, is this is treating everything as is. That means if the source cell was text, then the destination cell will be text. To convert from date as text to date as Excel serial that is a separate issue and there are plenty of ways to achieve that as well.
Option Explicit
Sub SortOffer(OfferList As Range)
Dim CounterX As Long, CounterY As Long, jCounter As Long, icounter As Long, MonthCount As Long, UniqueOffers As Long
Dim inlist As Boolean
Dim unsorted() As Variant
Dim sorted() As Variant
MonthCount = WorksheetFunction.CountIf(OfferList, "month*")
UniqueOffers = CountUnique(OfferList.Columns(1).Cells) - MonthCount - 1
ReDim sorted(1 To UniqueOffers + 1, 1 To MonthCount + 1) As Variant
unsorted = OfferList
CounterX = 1
jCounter = 1
sorted(1, 1) = "offer"
For CounterY = LBound(unsorted, 1) To UBound(unsorted, 1)
If Left(unsorted(CounterY, 1), 5) = "month" Then
CounterX = CounterX + 1
sorted(1, CounterX) = Right(unsorted(CounterY, 1), Len(unsorted(CounterY, 1)) - 6)
Else
inlist = False
For icounter = 2 To jCounter
If unsorted(CounterY, 1) = sorted(icounter, 1) Then
sorted(icounter, CounterX) = unsorted(CounterY, 2)
inlist = True
End If
Next icounter
If Not inlist And unsorted(CounterY, 1) <> "offer" And unsorted(CounterY, 1) <> "" Then
jCounter = jCounter + 1
sorted(jCounter, 1) = unsorted(CounterY, 1)
sorted(jCounter, CounterX) = unsorted(CounterY, 2)
End If
End If
Next CounterY
Range("F1").Resize(UBound(sorted, 1), UBound(sorted, 2)).Value = sorted
End Sub
This next function counts the number of unique entries in a range and does not count spaces. I stumbled across this code on this web page. If you subtract the number of months from this count, you will know how many offers are in your table. This is important because it will tell you how to size your array(alt link) that you will later write back as your results
Function CountUnique(ByVal MyRange As Range) As Integer
Dim Cell As Range
Dim J As Integer
Dim iNumCells As Integer
Dim iUVals As Integer
Dim sUCells() As String
iNumCells = MyRange.Count
ReDim sUCells(iNumCells) As String
iUVals = 0
For Each Cell In MyRange
If Cell.Text > "" Then
For J = 1 To iUVals
If sUCells(J) = Cell.Text Then
Exit For
End If
Next J
If J > iUVals Then
iUVals = iUVals + 1
sUCells(iUVals) = Cell.Text
End If
End If
Next Cell
CountUnique = iUVals
End Function
Now just in case the links don't cover it, this answer which was a learning lesson for me was taught in various parts to me by #JNevill, #Ralph, #findwindow, #Gary'sStudent and #ScottCraner. Appologies if I missed someone. I am also sure any of these individuals could do it slicker and take less then 10 hours to write it 8).
I am trying to create a UserForm in Excel 2010/2013 that will look through a list of items and return a complete list based on a number I provide.
Here's what the list would look like: See Example (image hosted on Imgur)
A Here's a snippit in case the image won't load...
Location ----- Title ----- Days Past
A2: 0001 | B2: Movie 1 | C2: 32
A3: 0001 | B3: Movie 2 | C3: 18
A4: 0001 | B4: Movie 3 | C4: 10
A5: 0004 | B5: Movie 1 | C5: 32
A6: 0007 | B6: Movie 1 | C6: 32
A7: 0007 | B7: Movie 2 | C7: 18
A8: 0009 | B8: Movie 1 | C8: 32
A9: 0014 | B9: Movie 1 | C9: 32
I have a userform that will return the first item in the list, but not the complete list. Ideally I would like to stay away from using a list box, mainly because the goal is to be able to copy the items in the full list.
I have tried the Index() formula but I don't know how to transfer that to work in VBA.
Any help you have would be great!
I have written this for you, which if your location values are given in the A column, Titles in the B and Days Past in the C this should work:
Private Sub SUBMITBUTTON_Click()
Dim counter As Integer, TITLELIST(), DAYSPAST(), fullString As String
fullString = ""
If LOCATIONTEXTBOX.Text = "" Then
MsgBox "Please input a location"
Exit Sub
End If
For Each Cell In ActiveSheet.UsedRange.Cells
If Cell.Value = LOCATIONTEXTBOX.Text Then
counter = counter + 1
End If
Next
ReDim TITLELIST(counter)
ReDim DAYSPAST(counter)
counter = 0
For i = 1 To Cells(1, 1).End(xlDown).Row
If Cells(1, i).Value = LOCATIONTEXTBOX.Text Then
TITLELIST(counter) = Cells(i, 2).Value
DAYSPAST(counter) = Cells(i, 3).Value
fullString = fullString & CStr(TITLELIST(counter)) & "," & CStr(DAYSPAST(counter)) & ","
counter = counter + 1
End If
Next
MsgBox fullString
Range("H8").Value = fullString
End Sub
If you change the names of SUBMITBUTTON and LOCATIONTEXTBOX then it should work in your userform.