Concatenating Using VBA based on Expiry Date

Z

zaska

Well-known Member
Joined
Oct 24, 2010
Messages
1,046
Hi...

<table border="0" cellpadding="0" cellspacing="0" width="302"><col style="mso-width-source:userset;mso-width-alt:3803;width:78pt" width="104"> <col style="mso-width-source:userset;mso-width-alt:4059;width:83pt" width="111"> <col style="mso-width-source:userset;mso-width-alt:3181;width:65pt" width="87"> <tbody><tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;width:78pt" height="20" width="104"> <table border="0" cellpadding="0" cellspacing="0" width="302"><col style="mso-width-source:userset;mso-width-alt:3803;width:78pt" width="104"> <col style="mso-width-source:userset;mso-width-alt:4059;width:83pt" width="111"> <col style="mso-width-source:userset;mso-width-alt:3181;width:65pt" width="87"> <tbody><tr style="height:15.0pt" height="20"> <td style="height:15.0pt;width:78pt" height="20" width="104">FUTSTK</td> <td style="width:83pt" width="111">VOLTAS</td> <td class="xl65" style="width:65pt" align="right" width="87">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>VOLTAS</td> <td class="xl65" align="right">29-Sep-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>WELCORP</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>WELCORP</td> <td class="xl65" align="right">25-Aug-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>WELCORP</td> <td class="xl65" align="right">29-Sep-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>WIPRO</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>WIPRO</td> <td class="xl65" align="right">29-Sep-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>YESBANK</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>YESBANK</td> <td class="xl65" align="right">25-Aug-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>YESBANK</td> <td class="xl65" align="right">29-Sep-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>ZEEL</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>ZEEL</td> <td class="xl65" align="right">25-Aug-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">FUTSTK</td> <td>ZEEL</td> <td class="xl65" align="right">29-Sep-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> <tr style="height:15.0pt" height="20"> <td style="height:15.0pt" height="20">OPTIDX</td> <td>BANKNIFTY</td> <td class="xl65" align="right">28-Jul-11</td> </tr> </tbody></table></td> <td class="xl63" style="border-left:none;width:83pt" width="111">
</td> <td class="xl63" style="border-left:none;width:65pt" width="87">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">I want to accomplish the following from the above table.

1. Delete all the Data for the "OPTIDX" Symbols. I want data only for the rows having "FUTSTK"

2. Append "-I" for 1st expiry date i.e 28-Jul-2011 and "-II" for 2nd Expiry Date i.e 29-Sep-2011 and "-III" for 3rd Expiry date.

Desired Output

VOLTAS-I
VOLTAS-II
WELCORP-I
WELCORP-II
WELCORP-III
WIPRO-I
WIPRO-II
YESBANK-I
YESBANK-II
YESBANK-III

Thank you


</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> <tr style="height:15.0pt" height="20"> <td class="xl63" style="height:15.0pt;border-top:none" height="20">
</td> <td class="xl63" style="border-top:none;border-left:none">
</td> <td class="xl64" style="border-top:none;border-left:none" align="right">
</td> </tr> </tbody></table>
 
Sort by date Sort by votes
Comment out these lines

Code: 
Columns("N:O").Delete
Columns("L").Delete
Columns("I:J").Delete
Columns("D:E").Delete
Columns("A").Delete
and run the code. Then work out which columns you need to delete. Then correct the above lines and uncomment them.

Note that you need to delete going from right to left.
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Code: 
'Columns("N:O").Delete
'Columns("L").Delete
'Columns("I:J").Delete
'Columns("D:E").Delete
'Columns("A").Delete
 
Upvote 0
Sir,

I didn't understand what is meant by commenting but I tried using "F8" and made the following changes. May i know whether the Highlighted elements in the code can be tweaked?

Code: 
Sub test()
ChDir "E:\Macros\Input"
Workbooks.Open Filename:="E:\Macros\Input\fo" & Format(Workbooks("NSE Converter.xls").Sheets("Sheet1").Range("G2").Value, "ddmmmyyyy") & "bhav.csv", Origin:=xlWindows
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
 With Range("A1:O" & LastRow)
     .AutoFilter Field:=1, Criteria1:="<>FUTIDX", Operator:=xlAnd, Criteria2:="<>FUTSTK"
     .Offset(1, 0).EntireRow.Delete
 End With
 ActiveSheet.AutoFilterMode = False
 LR = Range("A" & Rows.Count).End(xlUp).Row
    Columns("C").Insert
    Range("C2").Value = "-I"
For i = 3 To LR
    If Range("B" & i).Value = Range("B" & i - 1).Value Then
        Range("C" & i).Value = Range("C" & i - 1).Value & "I"
    Else
        Range("C" & i).Value = "-I"
    End If
Next i
For i = 2 To LR
    Range("B" & i).Value = Range("B" & i).Value & Range("C" & i).Value
    Range("D" & i).NumberFormat = "yyyymmdd"
    Range("D" & i).Value = Range("P" & i).Value
Next i
[COLOR=Red]Columns("C").Delete
Columns("N:O").Delete
Columns("L").Delete
Columns("J").Delete
Columns("D:E").Delete
Columns("A").Delete[/COLOR]
Range("B1").Value = "TIMESTAMP"
Range("I2:I" & LR).Formula = "=G2*LOOKUP(9.99999999999999E+307,SEARCH(""#""&'[NSE Converter.xls]Sheet1'!$A$1:$A$226,""#""&SUBSTITUTE(TRIM(A2),CHAR(160),"""")),'[NSE Converter.xls]Sheet1'!$B$1:$B$226)"
[COLOR=Red]For i = 2 To LR
Range("G" & i).Value = Range("I" & i).Value
Next i
[/COLOR][COLOR=Red]Columns("I").Delete
Rows("1").Delete[/COLOR]
Application.ScreenUpdating = True
ChDir "E:\Macros\Output"
ActiveWorkbook.SaveAs Filename:="E:\Macros\Output\Stocks\fo" & Format(Date, "ddmmmyyyy") & "bhav.txt", FileFormat:=xlCSV, CreateBackup:=False
Application.Screenupdationg = False
ActiveWindow.Close
 End Sub

Thank you
 
Upvote 0
Sir,

I tried to loop the Entire thing. I succeeded in getting the output but the Excel sheet is hanging and File "fo01JUN2011.Csv" is not closing. When i tried with F8 everything went fine.

I am unable to figure out the error in the below code. Kindly help me.

Code: 
Sub test()

 Dim strPath As String, startPath As String, Endpath As String, i As Long, buffer As String, startDate As Date, LR As Long
     
    startPath = "E:\Macros\Input\" 'current directory
    Endpath = "E:\Macros\Output\"   'output path
    startDate = "01-JUN-2011" 'DDMMMYYYY
    
    Do While buffer <> "02-JUL-2011"
        buffer = Format$(startDate, "DDMMMYYYY")
        strPath = startPath & "fo" & buffer & "bhav.csv"   'full path of the file you want to open
        otrpath = Endpath & "fo" & buffer & "bhav.txt"
        startDate = startDate + 1 'add one day
         
If Len(Dir(strPath)) > 0 Then
Workbooks.Open Filename:=(strPath)
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
 With Range("A1:O" & LastRow)
     .AutoFilter Field:=1, Criteria1:="<>FUTIDX", Operator:=xlAnd, Criteria2:="<>FUTSTK"
     .Offset(1, 0).EntireRow.Delete
 End With
 ActiveSheet.AutoFilterMode = False
 LR = Range("A" & Rows.Count).End(xlUp).Row
    Columns("C").Insert
    Range("C2").Value = "-I"
For i = 3 To LR
    If Range("B" & i).Value = Range("B" & i - 1).Value Then
        Range("C" & i).Value = Range("C" & i - 1).Value & "I"
    Else
        Range("C" & i).Value = "-I"
    End If
Next i
For i = 2 To LR
    Range("B" & i).Value = Range("B" & i).Value & Range("C" & i).Value
    Range("D" & i).NumberFormat = "yyyymmdd"
    Range("D" & i).Value = Range("P" & i).Value
Next i
Columns("C").Delete
Columns("N:O").Delete
Columns("L").Delete
Columns("J").Delete
Columns("D:E").Delete
Columns("A").Delete
Range("B1").Value = "TIMESTAMP"
Range("I2:I" & LR).Formula = "=G2*LOOKUP(9.99999999999999E+307,SEARCH(""#""&'[NSE Converter.xls]Sheet1'!$A$1:$A$226,""#""&SUBSTITUTE(TRIM(A2),CHAR(160),"""")),'[NSE Converter.xls]Sheet1'!$B$1:$B$226)"
For i = 2 To LR
Range("G" & i).Value = Range("I" & i).Value
Next i
Columns("I").Delete
Rows("1").Delete
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=(otrpath), CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
Loop

 End Sub

Thank u
 
Upvote 0
Sir,

I got "Not Respoding Error " after running the below code. Kindly have a look . I hope there is a minor error in the code.

Code: 
Sub test()   Dim strPath As String, startPath As String, Endpath As String, i As Long, buffer As String, startDate As Date, LR As Long           startPath = "E:\Macros\Input\" 'current directory     Endpath = "E:\Macros\Output\"   'output path     startDate = "01-JUN-2011" 'DDMMMYYYY          Do While buffer <> "02-JUL-2011"         buffer = Format$(startDate, "DDMMMYYYY")         strPath = startPath & "fo" & buffer & "bhav.csv"   'full path of the file you want to open         otrpath = Endpath & "fo" & buffer & "bhav.txt"         startDate = startDate + 1 'add one day           If Len(Dir(strPath)) > 0 Then Workbooks.Open Filename:=(strPath) Application.ScreenUpdating = False LastRow = Cells(Rows.Count, "B").End(xlUp).Row  With Range("A1:O" & LastRow)      .AutoFilter Field:=1, Criteria1:="<>FUTIDX", Operator:=xlAnd, Criteria2:="<>FUTSTK"      .Offset(1, 0).EntireRow.Delete  End With  ActiveSheet.AutoFilterMode = False  LR = Range("A" & Rows.Count).End(xlUp).Row     Columns("C").Insert     Range("C2").Value = "-I" For i = 3 To LR     If Range("B" & i).Value = Range("B" & i - 1).Value Then         Range("C" & i).Value = Range("C" & i - 1).Value & "I"     Else         Range("C" & i).Value = "-I"     End If Next i For i = 2 To LR     Range("B" & i).Value = Range("B" & i).Value & Range("C" & i).Value     Range("D" & i).NumberFormat = "yyyymmdd"     Range("D" & i).Value = Range("P" & i).Value Next i Columns("C").Delete Columns("N:O").Delete Columns("L").Delete Columns("J").Delete Columns("D:E").Delete Columns("A").Delete Range("B1").Value = "TIMESTAMP" Range("I2:I" & LR).Formula = "=G2*LOOKUP(9.99999999999999E+307,SEARCH(""#""&'[NSE Converter.xls]Sheet1'!$A$1:$A$226,""#""&SUBSTITUTE(TRIM(A2),CHAR(160),"""")),'[NSE Converter.xls]Sheet1'!$B$1:$B$226)" For i = 2 To LR Range("G" & i).Value = Range("I" & i).Value Next i Columns("I").Delete Rows("1").Delete Application.ScreenUpdating = False Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=(otrpath), CreateBackup:=False ActiveWorkbook.Close Application.DisplayAlerts = True End If Loop   End Sub</pre>
 
Upvote 0
zaska said:
Sir,

I tried to loop the Entire thing. I succeeded in getting the output but the Excel sheet is hanging and File "fo01JUN2011.Csv" is not closing. When i tried with F8 everything went fine.

I am unable to figure out the error in the below code. Kindly help me.

Code: 
Sub test()

 Dim strPath As String, startPath As String, Endpath As String, i As Long, buffer As String, startDate As Date, LR As Long
     
    startPath = "E:\Macros\Input\" 'current directory
    Endpath = "E:\Macros\Output\"   'output path
    startDate = "01-JUN-2011" 'DDMMMYYYY
    
    Do While buffer <> "02-JUL-2011"
        buffer = Format$(startDate, "DDMMMYYYY")
        strPath = startPath & "fo" & buffer & "bhav.csv"   'full path of the file you want to open
        otrpath = Endpath & "fo" & buffer & "bhav.txt"
        startDate = startDate + 1 'add one day
         
If Len(Dir(strPath)) > 0 Then
Workbooks.Open Filename:=(strPath)
Application.ScreenUpdating = False
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
 With Range("A1:O" & LastRow)
     .AutoFilter Field:=1, Criteria1:="<>FUTIDX", Operator:=xlAnd, Criteria2:="<>FUTSTK"
     .Offset(1, 0).EntireRow.Delete
 End With
 ActiveSheet.AutoFilterMode = False
 LR = Range("A" & Rows.Count).End(xlUp).Row
    Columns("C").Insert
    Range("C2").Value = "-I"
For i = 3 To LR
    If Range("B" & i).Value = Range("B" & i - 1).Value Then
        Range("C" & i).Value = Range("C" & i - 1).Value & "I"
    Else
        Range("C" & i).Value = "-I"
    End If
Next i
For i = 2 To LR
    Range("B" & i).Value = Range("B" & i).Value & Range("C" & i).Value
    Range("D" & i).NumberFormat = "yyyymmdd"
    Range("D" & i).Value = Range("P" & i).Value
Next i
Columns("C").Delete
Columns("N:O").Delete
Columns("L").Delete
Columns("J").Delete
Columns("D:E").Delete
Columns("A").Delete
Range("B1").Value = "TIMESTAMP"
Range("I2:I" & LR).Formula = "=G2*LOOKUP(9.99999999999999E+307,SEARCH(""#""&'[NSE Converter.xls]Sheet1'!$A$1:$A$226,""#""&SUBSTITUTE(TRIM(A2),CHAR(160),"""")),'[NSE Converter.xls]Sheet1'!$B$1:$B$226)"
For i = 2 To LR
Range("G" & i).Value = Range("I" & i).Value
Next i
Columns("I").Delete
Rows("1").Delete
Application.ScreenUpdating = False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=(otrpath), CreateBackup:=False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End If
Loop

 End Sub
Thank u
Click to expand...
bump
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
622
smozgur
smozgur
E
  • Question Question
VBA code clean up
Replies
9
Views
582
mumps
mumps
A
  • Question Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
2K
Attrazion
A
E
  • Question Question
VBA for Web Scraping help
Replies
0
Views
921
epactheactor
E
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
2K
CrashOD
C

Forum statistics

Threads
1,224,585
Messages
6,179,706
Members
452,939
Latest member
WCrawford

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top