I need to reduce the code where am I writing the synatx manytimes for copying and pasting the row values.
Private Sub btn_upload_Click()
'Frm_Mainform.Show
'MsgBox ("Process Complete - Please Check File in Output Folder")
Const FOLDER As String = "C:\SBI_Files\"
On Error GoTo ErrorHandler
Dim i As Integer
i = 18
Dim fileName As String
fileName = Dir(FOLDER, vbDirectory)
Do While Len(fileName) > 0
If Right$(fileName, 4) = "xlsx" Or Right$(fileName, 3) = "xls" Then
i = i + 1
Dim currentWkbk As Excel.Workbook
Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
Cells(i, 1) = fileName
Cells(i + 1, 2) = "Equity"
Cells(i + 2, 2) = "Forex NOOP"
Cells(i + 3, 2) = "Fixed Income Securities ( including CP, CD, G Sec)"
Cells(i + 4, 2) = "Total"
Cells(i, 2) = "Details"
Cells(i, 3) = "Limit"
Cells(i, 4) = "Min Var"
Cells(i, 5) = "Max Var"
Cells(i, 6) = "No. of Breaches"
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G8:G8").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H8:H8").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I8:I8").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J8:J8").Value
i = i + 1
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G9:G9").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H9:H9").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I9:I9").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J9:J9").Value
i = i + 1
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G10:G10").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H10:H10").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I10:I10").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J10:J10").Value
i = i + 1
Cells(i + 1, 3) = currentWkbk.Sheets("VaR").Range("G11:G11").Value
Cells(i + 1, 4) = currentWkbk.Sheets("VaR").Range("H11:H11").Value
Cells(i + 1, 5) = currentWkbk.Sheets("VaR").Range("I11:I11").Value
Cells(i + 1, 6) = currentWkbk.Sheets("VaR").Range("J11:J11").Value
i = i + 1
currentWkbk.Close
End If
fileName = Dir
Loop
ProgramExit:
Exit Sub
ErrorHandler:
MsgBox Err.Number & " - " & Err.Description
Resume ProgramExit
End Sub
You can replace all your Cells lines with these 4
update: added line for coping formats
'other code
Set currentWkbk = Excel.Workbooks.Open(FOLDER & fileName)
Cells(i, 1) = fileName
Cells(i + 1, 2).Resize(4, 1) = Application.Transpose(Array("Equity", "Forex NOOP", "Fixed Income Securities ( including CP, CD, G Sec)", "Total"))
Cells(i, 2).Resize(1, 5) = Array("Details", "Limit", "Min Var", "Max Var", "No. of Breaches")
Cells(i + 1, 3).Resize(4, 4) = currentWkbk.Sheets("VaR").Range("G8:J11").Value
currentWkbk.Sheets("VaR").Range("G8:J11").Copy Cells(i + 1, 3)
currentWkbk.Close
Related
I am organizing a dirty text in an organised table. And this code stops when the cell the marked line is completed. Can you help me to make it continuing the loop?
Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim sh7 As Worksheet
Dim CNAME As String
Set sh = Worksheets("Sheet6")
Set sh7 = Worksheets("Sheet7")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
For n = 1 To lr
If InStr(1, sh.Cells(n, 1), "CALL:") = 1 Then
CNAME = sh.Cells(n, 7).Value
Ci = sh.Cells(n + 1, 7).Value
Cpd = sh.Cells(n + 1, 7).Value
Else
If InStr(1, sh.Cells(n, 1), "Topic:") = 1 Then
T = sh.Cells(n, 2)
Tpd = sh.Cells(n + 1, 2)
Types = sh.Cells(n + 4, 2)
DM = sh.Cells(n + 5, 2)
D = sh.Cells(n + 5, 4)
OD = sh.Cells(n + 6, 2)
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
sh7.Cells(lr7 + 1, 1).Value = CNAME '********This is the last line it runs.
sh7.Cells(lr7 + 1, 2).Value = Ci
sh7.Cells(lr7 + 1, 3).Value = Cpd
sh7.Cells(lr7 + 1, 4).Value = T
sh7.Cells(lr7 + 1, 5).Value = Tpd
sh7.Cells(lr7 + 1, 6).Value = Types
sh7.Cells(lr7 + 1, 7).Value = DM
sh7.Cells(lr7 + 1, 8).Value = D
sh7.Cells(lr7 + 1, 9).Value = OD
End If
End If
Next n
End Sub
You should get in the habit of defining all variables and supplying a default value.
EDIT:
It seems my original conclusion was incorrect. Upon further inspection I see what might be an issue in your code. Both times where you are trying to get the last row, you are using Rows.Count as a parameter.
Maybe change these
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(Rows.Count, 1).End(xlUp).Row
To this (note that I use the sheet variable in the first param)
lr = sh.Cells(sh.Rows.Count, 1).End(xlUp).Row
lr7 = sh7.Cells(sh7.Rows.Count, 1).End(xlUp).Row
lastColumn_Of_PO_line_Big_Table = Sheets("PO_line_Big_Table").UsedRange.Columns.Count + 1
a = Dict_Metadata.Keys
For Each b In a
For i = 1 To UBound(Arr_PO_line_Big_Table)
If Arr_PO_line_Big_Table(i, 1) = b Then
With Worksheets("PO_line_Big_Table")
nextRow = Sheets("Final_Result").Cells(Sheets("Final_Result").Rows.Count, 1).End(xlUp).row + 1
'.Cells(nextRow, "A") = strKey
'.Cells(i + 1, lastColumn_Of_PO_line_Big_Table) = "YES"
Union(.Cells(i + 1, "E"), .Cells(i + 1, "K"), .Cells(i + 1, "L"), .Cells(i + 1, "M")).Copy
Sheets("Final_Result").Range("B" & nextRow).PasteSpecial
End With
End If
Next
Next
Could someone please tell me why it doesn't paste the value in sheet "PO_line_Big_Table" to sheet Final_Result, thank you in advanced!!
I have a vba code that find the value at the intersection of columns and rows.
It works well with all my data except for one : it returns NA.
The value i want to return is the same as usual, it just doesn't work with this intersection.
Can you help me figure out why?
Thank you
With Perftitres
Set VMt = Data1.Range("U:U")
Set Ticker = Data1.Range("H:H")
End With
' Calculs de perf
For Each sht In Perftitres.Worksheets
If sht.Visible = True Then
If sht.Cells(1, 1) = "" Then
sht.Cells(1, 1) = "Date"
sht.Cells(1, 2) = "Code du placement"
sht.Cells(1, 3) = "Valeur marchande t"
sht.Cells(1, 4) = "Valeur marchande t-1"
sht.Cells(1, 5) = "Valeur des achats"
sht.Cells(1, 6) = "Valeur des ventes"
sht.Cells(1, 7) = "Facteur"
sht.Cells(1, 8) = "Rendement 1 mois"
End If
LastRowsht = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
LastColumnsht = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
sht.Cells(LastRowsht + 1, 1) = 20 & Left(Dateupdate, 2) & "-" & Right(Dateupdate, 2)
sht.Cells(LastRowsht + 1, 2) = sht.Name
sht.Cells(LastRowsht + 1, 3) = Application.Index(VMt, Application.Match(sht.Cells(LastRowsht + 1, 2), Ticker))
End If
Next sht
Data1.Visible = True
Data2.Visible = True
This line doesn't work as expected for only one sheet. For every other one it works.
sht.Cells(LastRowsht + 1, 3) = Application.Index(VMt, Application.Match(sht.Cells(LastRowsht + 1, 2), Ticker))
I just found the answer :
sht.Cells(LastRowsht + 1, 3) = Application.Index(VMt, Application.Match(sht.Cells(LastRowsht + 1, 2), Ticker,0),0)
I had to had 0 and 0 for exact matches
I've been trying to find a solution for this error for several hours and I can't make it work. The code worked before I aggregated the AND statements in the first if And (final.Cells(j, 4) = rawSort(m, 2)) And (final.Cells(j, 6) = rawSort(m, 3)) and if i remove it it works but not with the desired result.
I don't know what to do, any help will be appreciated.
Here is the function (j is an index)
Public Function waste%(j)
Set final = ActiveWorkbook.Sheets("Master file")
Set rawSort = ActiveWorkbook.Sheets("Input Volume")
Dim index As Integer
index = rawSort.Cells(rows.Count, "A").End(xlUp).row
For m = 2 To index
If (final.Cells(j, 2) = rawSort.Cells(m, 1) And (final.Cells(j, 4) = rawSort(m, 2)) And (final.Cells(j, 6) = rawSort(m, 3))) Then
If (rawSort.Cells(m, 2) = "March" Or rawSort.Cells(m, 2) = "June" Or rawSort.Cells(m, 2) = "September" Or rawSort.Cells(m, 2) = "December") And rawSort.Cells(m - 1, 1) = rawSort.Cells(m, 1) And rawSort.Cells(m - 2, 1) = rawSort.Cells(m, 2) And m > 3 Then
final.Cells(j, 37) = final.Cells(j, 31) / (final.Cells(j, 31) + rawSort.Cells(m - 2, 10).Value + rawSort.Cells(m - 1, 10).Value + rawSort.Cells(m, 10).Value) 'local
ElseIf rawSort.Cells(m, 2).Value = "March" Or rawSort.Cells(m, 2).Value = "June" Or rawSort.Cells(m, 2).Value = "September" Or rawSort.Cells(m, 2).Value = "December" And rawSort.Cells(m - 1, 1).Value = rawSort.Cells(m, 1).Value And m > 2 Then
final.Cells(j, 37) = final.Cells(j, 31) / (final.Cells(j, 31) + rawSort.Cells(m - 1, 10).Value + rawSort.Cells(m, 10).Value) 'local
ElseIf rawSort.Cells(m, 2).Value = "March" Or rawSort.Cells(m, 2).Value = "June" Or rawSort.Cells(m, 2).Value = "September" Or rawSort.Cells(m, 2).Value = "December" And m > 1 Then
final.Cells(j, 37) = final.Cells(j, 31) / (final.Cells(j, 31) + rawSort.Cells(m, 10).Value) 'local
Else
final.Cells(j, 37) = "lel" 'error message, will be removed later
End If
Else
final.Cells(j, 37) = Null
End If
Next m
End Function
The three components of your if statement are as follow:
Final.Cells(j, 2) = rawSort.Cells(m, 1)
Final.Cells(j, 4) = rawSort(m, 2)
Final.Cells(j, 6) = rawSort(m, 3)
Notice anything? You're missing '.cells' in the second two.
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