I have a 5 by 5 matrix I want to populate and I would like to simplify this into for loops.
As I understand, I would need 2 for loops to complete this task?
I am still very new to VB hope you could understand
Dim x(4, 4) As Char
x(0, 0) = Mid(key, 1, 1)
x(0, 1) = Mid(key, 2, 1)
x(0, 2) = Mid(key, 3, 1)
x(0, 3) = Mid(key, 4, 1)
x(0, 4) = Mid(key, 5, 1)
x(1, 0) = Mid(key, 6, 1)
x(1, 1) = Mid(key, 7, 1)
....
x(4, 4) = Mid(key, 25, 1)
Try something like this:
Dim x As Integer
Dim y As Integer
Dim myMatrix(4, 4) As Char
For x = 0 To 4
For y = 0 To 4
myMatrix(x, y) = Mid(key, (x * 5) + y + 1, 1)
Next
Next
Related
I need to modify a for-loop, so that it skips to the next iteration when it does not find an object. Here is a snippet:
For j = 0 To i - 1
Proj = Cells(3 + j, 2).Value
ResClass = Cells(3 + j, 3).Value
Set project = resq.Projects.Item(Proj)
Set class = project.ReservingClasses(ResClass)
Set CFP = class.Vectors("Cashflow DFM JM").Method
Set CFPvol5 = class.Vectors("Cashflow DFM JM vol5").Method
Set CFPTr = class.Vectors("Cashflow DFM JM Tr").Method
orig = project.OriginCount
For k = 1 To orig
Cells(20 - 3, 4) = "DFM JM"
Cells(20 - 3, 4).Font.Bold = True
Cells(20 + k, col) = CFP.CashFlowPeriodLabel(k) - orig
Cells(20 - 2, col) = Cells(3 + j, 1).Value
Cells(20 - 2, col).Font.Bold = True
Cells(20 - 1, col + 1) = CFP.CashFlowPeriodLabel(1)
Cells(20 + k, col + 1) = Round(CFP.DiscountedCashflows(k, 1), 0)
Cells(20 - 1, col + 2) = CFP.CashFlowPeriodLabel(2)
Cells(20 + k, col + 2) = Round(CFP.DiscountedCashflows(k, 2), 0)
Cells(59 - 3, 4) = "DFM Paid vol5"
Cells(59 - 3, 4).Font.Bold = True
Cells(59 + k, col) = CFPvol5.CashFlowPeriodLabel(k) - orig
Cells(59 - 2, col) = Cells(3 + j, 1).Value
Cells(59 - 2, col).Font.Bold = True
Cells(59 - 1, col + 1) = CFPvol5.CashFlowPeriodLabel(1)
Cells(59 + k, col + 1) = Round(CFPvol5.DiscountedCashflows(k, 1), 0)
Cells(59 - 1, col + 2) = CFPvol5.CashFlowPeriodLabel(2)
Cells(59 + k, col + 2) = Round(CFPvol5.DiscountedCashflows(k, 2), 0)
Cells(98 - 3, 4) = "DFM JM Tr"
Cells(98 - 3, 4).Font.Bold = True
Cells(98 + k, col) = CFPTr.CashFlowPeriodLabel(k) - orig
Cells(98 - 2, col) = Cells(3 + j, 1).Value
Cells(98 - 2, col).Font.Bold = True
Cells(98 - 1, col + 1) = CFPTr.CashFlowPeriodLabel(1)
Cells(98 + k, col + 1) = Round(CFPTr.DiscountedCashflows(k, 1), 0)
Cells(98 - 1, col + 2) = CFPTr.CashFlowPeriodLabel(2)
Cells(98 + k, col + 2) = Round(CFPTr.DiscountedCashflows(k, 2), 0)
Next k
col = col + 4
Next
If for a certain j in the first for-loop there is no CFPvol5 in the second for-loop, then the procedure stops with an error. I want the procedure to continue with the next block, in this case with CFPTr. Is this possible? And if yes, how?
Thank you very much for your help!
Shown 2 methods: Just a sample.
on error resume next
For i = 1 to x
'do your stuff here
next
on error goto 0
or
on error goto nextLoop
for i = 1 to x
' do your stuff here
nextLoop:
next
I have a code below that needs to be tweaked, as I want to be able to enter my sheet name in an input box and have it reformat the sheet and output next to the sheet I select.
See formula I attempted but failed.
Sub Chart()
Dim wb As Workbook
Dim wsRaw As Worksheet, wsResult As Worksheet
Dim iRow As Byte, iCol As Byte, iResultRow As Byte, iRawCol As Byte
Dim Result As String
Result = InputBox("Provide a sheet name.")
Workbooks(wb).Sheets(Result).Select
Set wb = ThisWorkbook
Set wsRaw = Application.ActiveSheet
Set wsResult = Worksheets.Add(After:=Sheets(Worksheets.count))
iRow = 2
iResultRow = 2
Do Until wsRaw.Cells(iRow, 1) = Empty
wsResult.Cells(iResultRow, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 1, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 2, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 1, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 2, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 1, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 2, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 1, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 2, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow, 5) = "Lender"
wsResult.Cells(iResultRow + 1, 5) = "All"
wsResult.Cells(iResultRow + 2, 5) = "Percent"
iRawCol = 5
iCol = 6
Do Until iCol = 46
wsResult.Cells(1, iCol) = Left(wsRaw.Cells(1, iRawCol), 9)
wsResult.Cells(iResultRow, iCol) = wsRaw.Cells(iRow, iRawCol)
wsResult.Cells(iResultRow + 1, iCol) = wsRaw.Cells(iRow, iRawCol + 1)
wsResult.Cells(iResultRow + 2, iCol) = wsRaw.Cells(iRow, iRawCol + 2)
iCol = iCol + 1
iRawCol = iRawCol + 3
Loop
iResultRow = iResultRow + 3
iRow = iRow + 1
Loop
Sheets("Macros").Select
End Sub
Sub Chart()
Dim wb As Workbook
Dim wsRaw As Worksheet, wsResult As Worksheet
Dim iRow As Byte, iCol As Byte, iResultRow As Byte, iRawCol As Byte
Dim Result As Worksheet, RangeResult As Range
Set wb = ThisWorkbook
Set ResultRange = Application.InputBox("Provide a sheet name.", Type:=8)
Set Result = ResultRange.Parent
wb.Result.Select
Set wsRaw = Application.ActiveSheet
Set wsResult = Worksheets.Add(After:=Sheets(Worksheets.Count))
iRow = 2
iResultRow = 2
Do Until wsRaw.Cells(iRow, 1) = Empty
wsResult.Cells(iResultRow, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 1, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow + 2, 1) = wsRaw.Cells(iRow, 1)
wsResult.Cells(iResultRow, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 1, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow + 2, 2) = wsRaw.Cells(iRow, 2)
wsResult.Cells(iResultRow, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 1, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow + 2, 3) = wsRaw.Cells(iRow, 3)
wsResult.Cells(iResultRow, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 1, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow + 2, 4) = wsRaw.Cells(iRow, 4)
wsResult.Cells(iResultRow, 5) = "Lender"
wsResult.Cells(iResultRow + 1, 5) = "All"
wsResult.Cells(iResultRow + 2, 5) = "Percent"
iRawCol = 5
iCol = 6
Do Until iCol = 46
wsResult.Cells(1, iCol) = Left(wsRaw.Cells(1, iRawCol), 9)
wsResult.Cells(iResultRow, iCol) = wsRaw.Cells(iRow, iRawCol)
wsResult.Cells(iResultRow + 1, iCol) = wsRaw.Cells(iRow, iRawCol + 1)
wsResult.Cells(iResultRow + 2, iCol) = wsRaw.Cells(iRow, iRawCol + 2)
iCol = iCol + 1
iRawCol = iRawCol + 3
Loop
iResultRow = iResultRow + 3
iRow = iRow + 1
Loop
Sheets("Macros").Select
End Sub
I am fairly inexperienced with VBA, and I can't figure out how to make this loop. I set up 4 separate statements and it works this way, but I want to make this one statement.
i = 1
Do Until i > combos
Range(Cells(i, 10), Cells(i + Defrepeat - 1, 10)) = Range(Cells(3, 4), Cells(3, 4))
i = i + TErepeat
Loop
w = 4
Do Until w > combos
Range(Cells(w, 10), Cells(w + Defrepeat - 1, 10)) = Range(Cells(4, 4), Cells(4, 4))
w = w + TErepeat
Loop
p = 7
Do Until p > combos
Range(Cells(p, 10), Cells(p + Defrepeat - 1, 10)) = Range(Cells(5, 4), Cells(5, 4))
p = p + TErepeat
Loop
k = 10
Do Until k > combos
Range(Cells(k, 10), Cells(k + Defrepeat - 1, 10)) = Range(Cells(6, 4), Cells(6, 4))
k = k + TErepeat
Loop
Dim c As Range, i As Long, n As Long
Set c = Cells(3, 4)
For n = 1 To 10 Step 3
i = n
Do Until i > combos
Range(Cells(i, 10), Cells(i + Defrepeat - 1, 10)) = c.Value
i = i + TErepeat
Loop
Set c = c.Offset(1, 0)
Next n
I consulted you guys yesterday with a very vague question. I have now managed to isolate the problem, but obviously not solved it as I am writing here.
The problem for me is to assign a variable the value/content of matrix (or variant of variant). Not sure if this is redundant, but I want to have something like the following in my spreadsheet:
A B C D E F
1 a b c d
2 e f g h
3 aa bb cc dd
4 ee ff gg hh
Here is the code:
Public Sub Test()
Dim sub_data As Variant
Dim sheet_name As String
Dim str As String
Dim rng As Range
sheet_name = "Sheet1"
Set rng = Sheets(sheet_name).Range("A1")
Worksheets(sheet_name).Cells.ClearContents
On Error Resume Next
str = "A" & CStr(print_row)
ReDim sub_data(0 To 1, 0 To 1, 0 To 3)
sub_data(0, 0, 0) = "a"
sub_data(0, 0, 1) = "b"
sub_data(0, 0, 2) = "c"
sub_data(0, 0, 3) = "d"
sub_data(0, 1, 0) = "e"
sub_data(0, 1, 1) = "f"
sub_data(0, 1, 2) = "g"
sub_data(0, 1, 3) = "h"
sub_data(1, 0, 0) = "aa"
sub_data(1, 0, 1) = "bb"
sub_data(1, 0, 2) = "cc"
sub_data(1, 0, 3) = "dd"
sub_data(1, 1, 0) = "ee"
sub_data(1, 1, 1) = "ff"
sub_data(1, 1, 2) = "gg"
sub_data(1, 1, 3) = "hh"
Call PrintArray(sub_data, str)
End Sub
Public Sub PrintArray(Data As Variant, Cl As String)
Dim ubnd_1, ubnd_2 As Integer
Dim sub_data As Variant
ubnd_1 = UBound(Data, 2)
ubnd_2 = UBound(Data, 3)
sub_data = Data(0) 'THIS LINE WON'T WORK. HOW TO ASSIGN CORRECTLY?
'here I want to print the content of the Data-variable onto the sheet
Range(Cl).Resize(ubnd_2 + 1, ubnd_1 + 1) = Application.Transpose(sub_data)
End Sub
You do not need a 3D array. I have changed your 3D to a 2D as two dimensions are all you need for your example. Spreadsheet is 2D anyways so transposing a 3D array just sounds impossible.
The easiest way
Public Sub PrintArray(Data As Variant)
Range("A10").Resize(UBound(Data, 1), UBound(Data, 2)) = Data
End Sub
but you have to make sure you change the dimensions of your matrix/array
Option Explicit
Public Sub Test()
Sheets(1).Cells.ClearContents
ReDim sub_data(1 To 4, 1 To 4)
sub_data(1, 1) = "a"
sub_data(1, 2) = "b"
sub_data(1, 3) = "c"
sub_data(1, 4) = "d"
sub_data(2, 1) = "e"
sub_data(2, 2) = "f"
sub_data(2, 3) = "g"
sub_data(2, 4) = "h"
sub_data(3, 1) = "aa"
sub_data(3, 2) = "bb"
sub_data(3, 3) = "cc"
sub_data(3, 4) = "dd"
sub_data(4, 1) = "ee"
sub_data(4, 2) = "ff"
sub_data(4, 3) = "gg"
sub_data(4, 4) = "hh"
Call PrintArray(sub_data)
End Sub
Public Sub PrintArray(Data As Variant)
Range("A1:A" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 1, 0))
Range("B1:B" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 2, 0))
Range("C1:C" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 3, 0))
Range("D1:D" & UBound(Data, 2)) = WorksheetFunction.Transpose(WorksheetFunction.Index(Data, 4, 0))
End Sub
So I have changed your sub_data to a 2D variant. The structure remains the same as you expected it to be.
I have a list of data which needs to be printed out on stickers (imagine the Avery kind). I'm having trouble coming up with the code that will produce the desired result:
My code thus far is:
With wsEtiketten
' erase old data
.Cells.Clear
' enter new data
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
For j = 0 To 4
r.Copy .Cells(4, 2).Offset(i * 5, j * 5)
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Ordernr
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((i * 5) + 1, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Count
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((i * 5) + 3, (j * 5) + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next j
Next i
End With
The information which is tied to it is simply repeated across the row. I need i to change every time the field is offset. How can I do that? I'm sure this is probably programming kindergarden stuff but I'm not getting it.
Thanks!
Maybe an answer with an unexpected twist. You can use an Excel table in combination with Word to get the result you want as well. This is standard Office functionality:
http://support.microsoft.com/kb/318117/en
or in German:
http://support.microsoft.com/kb/318117/de
Ok. I managed to come up with an answer within Excel. Once I had it, it was obvious.
Here goes:
With wsEtiketten
' Alte Daten werden gelöscht
.Cells.Clear
' Neue Daten werden eingelesen
With .Cells(1, 2)
.Value = "Lettrine"
.Font.Bold = True
End With
.Cells(2, 2).Value = sAuswertungsLettrine
For i = 0 To MaxRow - 1
r.Copy .Cells(4, 2).Offset(WorksheetFunction.RoundDown(i / 5, 0) * 5, ((i + 5) Mod 5) * 5)
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 1).Value 'Page
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 2).Value 'Bestellnummer
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 2) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 8).Value 'Surf
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 1, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 9).Value 'Indice DB
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 0) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 3).Value 'Anzahl
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 1) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 4).Value 'CA Brut
.Cells(4, 2).Offset((WorksheetFunction.RoundDown(i / 5, 0)) * 5 + 3, ((i + 5) Mod 5) * 5 + 3) = wsSheet.ListObjects(1).DataBodyRange.Cells(i + 1, 7).Value 'Marge
Next i
End With