I'm still new to VBA EXCEL programming.
I need to extract data from one sheet to another in a different format. However, many of the tutorial only seems to extract data rows by rows or range by range to a fresh sheet.
So this is my DataSheet1:
**School Principal Student Student ID**
United College Bill Gates Peter p3214
United College Bill Gates Mary p4213
United College Bill Gates Forge p7621
Beverly High Melin Brad Goge p1111
Beverly High Melin Brad Fred p2222
I want to make the data into a custom format in another datasheet. So here's my desired result:
School United College
Principal Bill Gates
Student Student ID
Peter p3214
Mary p4213
Forge p7621
School Beverly High
Principal Melinda Brad
Student Student ID
Goge p1111
Fred p2222
Below are some of my codes to get from Sheet1 to Sheet2, but the code only shows to get the data from range to range. What are some of the concepts that should be used to extract the data into a custom format? My codes:
Dim secondsheet As Worksheet
Set secondsheet = workbook.Worksheets(2)
Dim firstsheet As Worksheet
Set firstsheet = workbook.Worksheets(1)
secondsheet.Range("A1", "C10").Value = firstsheet.Range("A1", "C10").Value
And the format that I intend to put my data in:
Range(<<call function for range>>).Select
With Selection
.Value = "School"
.Offset(1,0).Value = "Principal"
.Offset(1,0).Font.Bold = True
.Offset(4,1).Value = "Student"
.Offset(4,1).Font.Bold = True
.Offset(4,2).Value = "Student ID"
.Offset(4,2).Font.Bold = True
So the answer I looking for is looping function since it's in this format. Any kind souls are willing to help me understand the concept for vba?
Keep Data in Sheet1 and Run the macro... Small errors are there in my macro.. If u work it out can easily rectify
col1 = Sheet1.Cells(2, 1)
prin1 = Sheet1.Cells(2, 2)
Sheet2.Cells(1, 1) = "School"
Sheet2.Cells(1, 2) = "Principal"
Sheet2.Cells(2, 1) = col1
Sheet2.Cells(2, 2) = prin1
b = 5
c = 1
Sheet2.Cells(b - 1, 1) = "Student"
Sheet2.Cells(b - 1, 2) = "St ID"
a = 3
Do While Sheet1.Cells(a, 1) <> ""
If col1 = Sheet2.Cells(c + 1, 1) Then
Sheet2.Cells(b, 1) = Sheet1.Cells(a, 3)
Sheet2.Cells(b, 2) = Sheet1.Cells(a, 4)
b = b + 1
Else
c = b + 1
b = c + 3
col1 = Sheet1.Cells(a, 1)
prin1 = Sheet1.Cells(a, 2)
Sheet2.Cells(c, 1) = "School"
Sheet2.Cells(c, 2) = "Principal"
Sheet2.Cells(c + 1, 1) = col1
Sheet2.Cells(c + 1, 2) = prin1
Sheet2.Cells(b - 1, 1) = "Student"
Sheet2.Cells(b - 1, 2) = "St ID"
Sheet2.Cells(b, 1) = Sheet1.Cells(a, 3)
Sheet2.Cells(b, 2) = Sheet1.Cells(a, 4)
End If
a = a + 1
Loop
Related
I have a sheet with 2 tables. I want to find and return the cell of column 1 which has the minimum proteges.
For example, my code would return either Phil,Levy or Sean, Montain in the first run. (then my spreadsheet will add +1 to one of the two - this is already set in excel). etc....
Coach List Protégées
Phil, Levy 7
Sean, Monteine 7
Victor, Chatelais 8
I have write a code but unfortunately ot does it randomly. Any thoughts ?
Code:
Dim Coach As String
Dim ws As Worksheet, t As ListObject, r As Long
For Each t In MyWorksheet.ListObjects
Select Case t.Name
Case "Table1", "Table3", "Table4", "Table6", "Table8", "Table10", "Table12", "Table14", "Table16"
'do nothing
Case Else
'Coach = Application.WorksheetFunction.Min(t.ListColumns(2).Range)--> could use that ?
For r = 1 To t.DataBodyRange.Rows.Count
For r = t.DataBodyRange.Rows.Count To 1 Step -1
If t.DataBodyRange(r, 2) <= t.DataBodyRange(r + 1, 2) Then
Coach = t.DataBodyRange(r , 1)
End If
Next r
End Select
Next t
I think your method needs a variable for the lowest number found as each row is compared.
p = 9999
For r = 1 To t.DataBodyRange.Rows.Count
If t.DataBodyRange(r, 2) <= p Then
p = t.DataBodyRange(r, 2)
Coach = t.DataBodyRange(r, 1)
End If
Next r
I have used Variants in the past for something similar, but it was one dimensional in its solution. I am wondering if utilizing Variants with two dimensions would be feasible.
I have ever changing list of dates that correspond with a week, that will be entered in chronologically. The next column is the count of that week. Column C is the building that it took place in.
For example, the first row shown in the image above takes place the week of "10/2/2016" and there was a count of 8 that week which means the buildings in rows 2-9 are correlated with that week, and it continues on for each corresponding week.
I have the sum of the counts for each year, so for the chart in "E1:G14", I want to count each time the building is counted for each year, respectively. I am just confused as to how to approach it and if Variants would be useful or if using a CountIfs for the ranges would work best.
Thank you in advance.
CODE
Private Sub maybe()
Dim sht As Worksheet: Set sht = Worksheets("Sheet3")
Dim wk_cnt As Double: wk_cnt = sht.Range("A1", sht.Range("A1").End(xlDown)).Rows.Count
Dim bld_cnt As Double: bld_cnt = sht.Range("C2", sht.Range("C2").End(xlDown)).Rows.Count
Dim cnt As Double
Dim yrs_cnt As Double
If sht.Range("D3").Value = "" Then
yrs_cnt = 1
Else:
yrs_cnt = sht.Range("D2", sht.Range("D2").End(xlDown)).Rows.Count
End If
Dim yrsArray As Range
If sht.Range("D3").Value = "" Then
Set yrsArray = sht.Range("D2")
Else:
Set yrsArray = sht.Range("D2", sht.Range("D2").End(xlDown))
End If
Dim vCnts As Variant
ReDim vCnts(1 To 12, 1 To yr_cnt)
vCnts(1, 1) = "Irving Building"
vCnts(2, 1) = "Memorial Building"
vCnts(3, 1) = "West Tower"
vCnts(4, 1) = "Witting Surgical Center"
vCnts(5, 1) = "Madison Irving Surgery Center"
vCnts(6, 1) = "Marley Education Center"
vCnts(7, 1) = "410 South Crouse"
vCnts(8, 1) = "Physicians Office Building"
vCnts(9, 1) = "Crouse Business Center"
vCnts(10, 1) = "Commonwealth Place"
vCnts(11, 1) = "Crouse Garage"
vCnts(12, 1) = "CNY Medical Center"
For x = 1 To yrs_cnt
cnt = 0
For y = 2 To wk_cnt
If Year(sht.Cells(y, 1).Value) = sht.Cells(1, x + 5).Value Then
cnt = cnt + sht.Cells(y, 2).Value
sht.Cells(14, x + 5) = cnt
End If
Next y
Next x
End Sub
EDIT
With Column C
With only Columns A & B
I need the numbers to match the second image, but when I include all three columns it looks like the first image after I group it by years year. How can I fix that?
It looks like your PivotTable is using the "Count" column improperly. Where it says "Count of Count", it's telling you that the number shown is how many lines on your data range fit the selected criteria. I think if you change the Value Field Settings to SUM you will be pleased with the difference. See below:
I am trying to write a macro on MS Excel, which will enable me to create random samples and pick random values from those samples for each category in the data.
To be more specific, the data is at 2 levels: firm and year, where each row represents a firm-year-peer observation. For each firm i, at a given year j, we have number of actual peers.
What I want to do is assign to each firm, from the whole sample throughout many years, a random firm from the list of all available firms at that specific year. The trick is that the number of firms to be assigned should be identical to the number of actual peers that a firm has at that year. Also, the randomly assigned values should be different from the firm's actual peers, and of course, the firm itself.
i j k
1 2006 100
1 2006 105
1 2006 110
2 2006 113
2 2006 155
2 2006 200
2 2006 300
For example, Firm 1's actual peers in year 2006 are 100, 105 and 110. However, all possible firms available are 100, 105, 110, 113, 155, 200 and 300. This means that I have to select 3 (because Firm 1 has 3 actual peers) random fictional peers from the 4 firms that are not Firm 1's peer that year (i.e. 113, 155, 200 and 300). Applying the same procedure for Firm 2, I need to select 4 random firms that are not Firm 2's actual peers from all possible firms.
I hope this was clear.
I started trying this function out on MS Excel, but I am open to suggestions if you think other platforms would be more useful.
Your help would be very much appreciated!
Thanks!
Many thanks to everyone who has visited my post.
After some initial struggling, I have managed to figure out the code myself. I am posting it below for anyone who might need it.
Basically I used the randomisation code posted by this gentle soul, and enhanced it for my needs using couple of flags for each new firm and each new year. Hope it is clear for everyone.
Best
Sub Random_Sampling()
'
Dim PeerCount, FirmCount, YearCount As Long
Dim Focal_CIK, fiscalYear As Long
Const nItemsTotal As Long = 1532
Dim rngList As Range
Dim FirmYearRange As Range
Dim FirmStart, FirmStartRow, YearStartRow As Long
Dim ExistingPeers As Range
Dim idx() As Long
Dim varRandomItems() As Variant
Dim i, j, k, m, n As Long
Dim iCntr, jCntr As Long
Dim booIndexIsUnique As Boolean
Set rngList = Sheets("Sheet2").Range("A2").Resize(nItemsTotal, 1)
FirmCount = Cells(2, 10).Value
For k = 1 To FirmCount
FirmStart = Application.WorksheetFunction.Match(k, Columns("E"), 0)
Focal_CIK = Cells(FirmStart, 1).Value
YearCount = Cells(FirmStart, 7).Value
For m = 1 To YearCount
Set FirmYearRange = Range("H" & FirmStart & ":H200000")
YearStartRow = Application.WorksheetFunction.Match(m, FirmYearRange, 0) + FirmStart - 1
fiscalYear = Cells(YearStartRow, 3).Value
PeerCount = Cells(YearStartRow, 9).Value
Set ExistingPeers = Range(Cells(YearStartRow + PeerCount, 2), Cells(YearStartRow + PeerCount, 2))
ReDim idx(1 To PeerCount)
ReDim varRandomItems(1 To PeerCount)
For i = 1 To PeerCount
Do
booIndexIsUnique = True ' Innoncent until proven guilty
idx(i) = Int(nItemsTotal * Rnd + 1)
For j = 1 To i - 1
If idx(i) = idx(j) Then 'Is already picked
ElseIf idx(i) = Focal_CIK Then 'Is the firm itself
booIndexIsUnique = False 'If true, don't pick it
Exit For
End If
For n = 1 To PeerCount
If idx(i) = Cells(YearStartRow + n - 1, 2).Value Then 'Is one of the actual peers
booIndexIsUnique = False 'If true, don't pick it
Exit For
Exit For
End If
Next n
Next j
If booIndexIsUnique = True Then
Exit Do
End If
Loop
varRandomItems(i) = rngList.Cells(idx(i), 1)
Rows(YearStartRow + PeerCount).EntireRow.Insert
'The order of the columns are very important for the following lines
Cells(YearStartRow + PeerCount, 1) = Focal_CIK
Cells(YearStartRow + PeerCount, 2) = varRandomItems(i)
Cells(YearStartRow + PeerCount, 3) = fiscalYear
Cells(YearStartRow + PeerCount, 4) = "0"
Next i
Next m
Next k
End Sub
I am working with a system that reports user data into two columns: Column A has the fields (9 total per record) and Column B has the corresponding user data.
Column A looks like this:
Last Name:
First Name:
Middle Name:
Card Number:
Employee Ref:
Personal Details:
Associate Number:
Location Name:
Status:
The formatting on this report has the fields repeated for each record, meaning that row 10 will be blank, and row 11 will be Last Name:, row 12 will be First Name:, etc. This format results in very lengthy reports that are difficult to manage.
Another complication to this report concerns null values. Fields with null values are excluded from the report. For example, a record that does not have a Location Name will exclude the Location Name: field altogether. The result of the missing field is a record that is 8 rows instead of the the normal 9 rows. Some of these records are missing multiple fields, on account of null values.
I am looking for an elegant way to reformat this report. Specifically, I'm looking for...
-The fields in Column A become Column headers (A,B,C,D,E,F,G,H,I).
-The data in Column B is moved onto a single row, aligned with the corresponding field headers.
The report I'm currently looking at has 3730 records. However, the system outputs a file that is 43906 rows (including blank rows). I'd like to get this report to 3731 rows (1 row for field headers + 3730 records).
Any assistance with reformatting this report would be greatly appreciated.
Thank you,
pheidias
Here is some sample data of 3 records:
• Last Name: #1
• First Name: Security
• Middle Name: Badge
• Card Number: 100
• Employee Ref: Security
• Personal Details: none
• Associate Number: N/A
• Location Name: HQ
• Status: Contractor / Temp
•
• Last Name: Doe
• First Name: John
• Middle Name:
• Card Number: 101
• Employee Ref:
•
• Last Name: Deere
• First Name: John
• Middle Name:
• Card Number: 102
• Employee Ref:
• Status: Associate
Try this.
Place the following routine into a standard code module:
Sub pheidias()
Dim c&, i&, t, v, w
With ActiveSheet.[a1]
v = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, 2)
End With
ReDim w(1 To UBound(v), 1 To 9)
t = Split(".Last Name.First Name.Middle Name.Card Number.Employee Ref.Personal Details.Associate Number.Location Name.Status.", ".")
For i = 1 To 9
w(1, i) = t(i)
Next
c = 2
For i = 1 To UBound(v)
If Len(v(i, 1)) Then
w(c, (InStr("lafimicaempeaslost", LCase$(Left$(v(i, 1), 2))) - 1) / 2 + 1) = v(i, 2)
Else
c = c + 1
End If
Next
[e1].Resize(UBound(w), UBound(w, 2)) = w
End Sub
Note: this routine assumes that the data start in cell A1 and that only ONE blank row separates each of the source report groups.
Note: the location of the output can be edited in the last line. The upper left-hand corner of the output report currently defaults to cell E1.
UPDATE
Try this also. The two versions are really the same, but the one below is probably easier to read...
Sub pheidias()
Dim c&, i&, v, w
With ActiveSheet.[a1]
v = .Resize(.Item(.Parent.Rows.Count).End(xlUp).Row, 2)
End With
ReDim w(1 To UBound(v), 1 To 9)
w(1, 1) = "Last Name"
w(1, 2) = "First Name"
w(1, 3) = "Middle Name"
w(1, 4) = "Card Number"
w(1, 5) = "Employee Ref"
w(1, 6) = "Personal Details"
w(1, 7) = "Associate Number"
w(1, 8) = "Location Name"
w(1, 9) = "Status"
c = 2
For i = 1 To UBound(v)
If Len(v(i, 1)) Then
Select Case LCase$(Left$(v(i, 1), 2))
Case "la": w(c, 1) = v(i, 2)
Case "fi": w(c, 2) = v(i, 2)
Case "mi": w(c, 3) = v(i, 2)
Case "ca": w(c, 4) = v(i, 2)
Case "em": w(c, 5) = v(i, 2)
Case "pe": w(c, 6) = v(i, 2)
Case "as": w(c, 7) = v(i, 2)
Case "lo": w(c, 8) = v(i, 2)
Case "st": w(c, 9) = v(i, 2)
End Select
Else
c = c + 1
End If
Next
[e1].Resize(UBound(w), UBound(w, 2)) = w
End Sub
I have two spreadsheets:
I want to match both sheets and make sure that dates match for every person. E.g. Person 1 has three different dates and I want to match them exactly 1:1.
Person 1, 3/2/2015 (Table A) -> Person 1, 3/2/2015 (Table B)
Person 1, 3/5/2015 (Table A) -> Person 1, 3/5/2015 (Table B)
Person 1, 3/6/2015 (Table A) -> Person 1, 3/6/2015 (Table B)
For the moment I loop through "No." column in Table A and use Application.VLookup on Table B but that only works when a Person has only one date. Otherwise it compares to the first date from Table B. See code:
For sheetArowCounter= 2 To sheetAlastRow
Sheets("A").Select
sheetAperson = Cells(sheetArowCounter, 1)
sheetAdate = Cells(sheetArowCounter, 2)
Sheets("B").Select
sheetBdate = Application.VLookup(sheetAperson, _
Sheets("B").Range(Cells(1, 1), Cells(sheetBLastRow, 2)), 2, False)
If IsError(sheetBdate ) Then
personFromTableAnotFound = personFromTableAnotFound + 1
ElseIf sheetBdate <> sheetAdate Then
sheetAdateNotMatched = sheetAdateNotMatched + 1
End If
sheetAdateCompared = sheetAdateCompared + 1
Next sheetArowCounter
Any idea how can I do that?
I agreed with Jeeped above. Try using a SUMIF. You can even nest the SUMIF in an IF statement to return text: ie: "Match", "No match"
I'd go for a countifs function which can test for criteria against multiple columns. Here is an example for how you could implement this in your code:
For sheetArowCounter = 2 To sheetAlastRow
Sheets("A").Select
sheetAperson = Cells(sheetArowCounter, 1)
sheetAdate = Cells(sheetArowCounter, 2)
Sheets("B").Select
'using the countifs function eg. =COUNTIFS(B!A3:A11,A!A3,B!B3:B11,A!B3)
PersonDateMatches = Application.WorksheetFunction.CountIfs(Sheets("B").Range(Cells(1, 1), Cells(sheetBLastRow, 1)), sheetAperson, Sheets("B").Range(Cells(1, 2), Cells(sheetBLastRow, 2)), sheetAdate)
If PersonDateMatches = 0 Then
personDateFromTableAnotFound = personDateFromTableAnotFound + 1
End If
sheetAdateCompared = sheetAdateCompared + 1
Next sheetArowCounter