Wednesday, March 30, 2005
Flip row or column
To flip the given row as shown in this figure, use the following macro
Result row
You can use the same macro for fliping columns too, code will find if it's a row or a column.
Note: This code was modified on 07/26/07 for error checking, and removal of Option Base
Result row
You can use the same macro for fliping columns too, code will find if it's a row or a column.
Note: This code was modified on 07/26/07 for error checking, and removal of Option Base
Sub flip()
Dim Arr As Variant
Dim myrange As Range
Dim vSplitedArr As Variant
Dim arRetArr() As Variant, lArrBnd As Long, i As Long
On Error GoTo flip_Error
Set myrange = Range(Selection.Address)
Arr = myrange 'store the selected values in an array
'split the selected cells address to an array
vSplitedArr = Split(Selection.Address, "$")
' check if Column names are same
If vSplitedArr(1) = vSplitedArr(3) Then
lArrBnd = UBound(Arr, 1)
ReDim arRetArr(lArrBnd, 0)
For i = 0 To lArrBnd - 1
'flip the array
arRetArr(i, 0) = Arr(lArrBnd - i, 1)
Next i
Range(Selection.Address) = arRetArr
'check if Row numbers are same
ElseIf Replace(vSplitedArr(2), ":", "") = vSplitedArr(4) Then
lArrBnd = UBound(Arr, 2)
ReDim arRetArr(0, lArrBnd)
For i = 0 To lArrBnd - 1
'flip the array
arRetArr(0, i) = Arr(1, lArrBnd - i)
Next i
Range(Selection.Address) = arRetArr
Else
MsgBox "Your selection contains multiple rows or columns." & vbCrLf & _
"This macro will only work on either one column or one row", vbCritical, "Flip Error"
End If
On Error GoTo 0
SmoothExit_flip:
Exit Sub
flip_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure flip"
Resume SmoothExit_flip
End Sub
Dim Arr As Variant
Dim myrange As Range
Dim vSplitedArr As Variant
Dim arRetArr() As Variant, lArrBnd As Long, i As Long
On Error GoTo flip_Error
Set myrange = Range(Selection.Address)
Arr = myrange 'store the selected values in an array
'split the selected cells address to an array
vSplitedArr = Split(Selection.Address, "$")
' check if Column names are same
If vSplitedArr(1) = vSplitedArr(3) Then
lArrBnd = UBound(Arr, 1)
ReDim arRetArr(lArrBnd, 0)
For i = 0 To lArrBnd - 1
'flip the array
arRetArr(i, 0) = Arr(lArrBnd - i, 1)
Next i
Range(Selection.Address) = arRetArr
'check if Row numbers are same
ElseIf Replace(vSplitedArr(2), ":", "") = vSplitedArr(4) Then
lArrBnd = UBound(Arr, 2)
ReDim arRetArr(0, lArrBnd)
For i = 0 To lArrBnd - 1
'flip the array
arRetArr(0, i) = Arr(1, lArrBnd - i)
Next i
Range(Selection.Address) = arRetArr
Else
MsgBox "Your selection contains multiple rows or columns." & vbCrLf & _
"This macro will only work on either one column or one row", vbCritical, "Flip Error"
End If
On Error GoTo 0
SmoothExit_flip:
Exit Sub
flip_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure flip"
Resume SmoothExit_flip
End Sub
Sunday, March 27, 2005
Description of the limitations for working with arrays in Excel 2000, Excel 2002, and Excel 2003
Check the following link, it provides limitations of using array formulas in Excel.
Description of the limitations for working with arrays in Excel 2000, Excel 2002, and Excel 2003
Note The following are helpful facts to remember about the functions.
• If any cells in an array are empty or contain text, MINVERSE returns the #VALUE! error value.
• MINVERSE also returns the #VALUE! error value if the array does not have an equal number of rows and columns.
• MINVERSE returns the #VALUE! error if the returned array exceeds 52 columns by 52 rows.
• The MMULT function returns #VALUE! if the output exceeds 5460 cells.
• The MDETERM function returns #VALUE! if the returned array is larger than 73 rows by 73 columns.
Description of the limitations for working with arrays in Excel 2000, Excel 2002, and Excel 2003
Note The following are helpful facts to remember about the functions.
• If any cells in an array are empty or contain text, MINVERSE returns the #VALUE! error value.
• MINVERSE also returns the #VALUE! error value if the array does not have an equal number of rows and columns.
• MINVERSE returns the #VALUE! error if the returned array exceeds 52 columns by 52 rows.
• The MMULT function returns #VALUE! if the output exceeds 5460 cells.
• The MDETERM function returns #VALUE! if the returned array is larger than 73 rows by 73 columns.
Thursday, March 10, 2005
Save HTML files from one folder to Excel files in another folder
This sub will open the specified file type from the specified directory and sace them as excel files. A file open dialog box will ask the user to select a file from the folder where the original files are kept. Then an output folder name will be asked and this folder should exist otherwise it would generate an error. Make the changes where commented and can be used for all other supported file types. Right now this sub will save the html files as excel files.
Public Sub saveas_XL()
Err.Clear
On Error GoTo errorhandler
Application.ScreenUpdating = False 'won't show changes in the application
ActiveSheet.Cells.Clear 'clear all the contents on the sheet
Dim infile, fpath, cutnum, outputfolder, msg As String, HtmlFpath, n As Long, F
n = 0
'change *.htm;*.html to the file type you want to save as an excel file
' a file open dialog box
infile = Application.GetOpenFilename("Html Files(*.htm;*.html),*.htm;*.html", , "Please select the HTML files folder")
If infile = False Then
Application.ScreenUpdating = True
Exit Sub
End If
'find path to the files
cutnum = InStrRev(infile, "\")
fpath = Left(infile, cutnum)
HtmlFpath = fpath
'change *.html to the file type
F = Dir(fpath & "*.html") 'will give the first file in that directory
Range("A1").Activate 'cell A1 selected
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir() 'second file
n = n + 1
Loop
Sheet1.Range(Cells(1, 2), Cells(n, 2)) = Sheet1.Range(Cells(1, 1), Cells(n, 1)).Value
'change .html to the extension type you want to save as an excel file
Sheet1.Range(Cells(1, 2), Cells(n, 2)).Replace What:=".html", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'will ask for the output folder where you want to save these files, this folder should exist
outputfolder = InputBox("Enter the outputfolder name", "Folder name")
fpath = Left(fpath, Len(fpath) - 1)
cutnum = InStrRev(fpath, "\")
fpath = Left(fpath, cutnum)
'will open all the files in Column B and save as xl files
For i = 1 To n
Workbooks.Open Filename:=HtmlFpath & Sheet1.Cells(i, 1)
ActiveWorkbook.SaveAs Filename:=fpath & outputfolder & "\" & Sheet1.Cells(i, 2), FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
MsgBox "Done"
Exit Sub
errorhandler:
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description & vbCrLf & vbCrLf & "Ending program now"
MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
Application.ScreenUpdating = True
End Sub
Err.Clear
On Error GoTo errorhandler
Application.ScreenUpdating = False 'won't show changes in the application
ActiveSheet.Cells.Clear 'clear all the contents on the sheet
Dim infile, fpath, cutnum, outputfolder, msg As String, HtmlFpath, n As Long, F
n = 0
'change *.htm;*.html to the file type you want to save as an excel file
' a file open dialog box
infile = Application.GetOpenFilename("Html Files(*.htm;*.html),*.htm;*.html", , "Please select the HTML files folder")
If infile = False Then
Application.ScreenUpdating = True
Exit Sub
End If
'find path to the files
cutnum = InStrRev(infile, "\")
fpath = Left(infile, cutnum)
HtmlFpath = fpath
'change *.html to the file type
F = Dir(fpath & "*.html") 'will give the first file in that directory
Range("A1").Activate 'cell A1 selected
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir() 'second file
n = n + 1
Loop
Sheet1.Range(Cells(1, 2), Cells(n, 2)) = Sheet1.Range(Cells(1, 1), Cells(n, 1)).Value
'change .html to the extension type you want to save as an excel file
Sheet1.Range(Cells(1, 2), Cells(n, 2)).Replace What:=".html", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'will ask for the output folder where you want to save these files, this folder should exist
outputfolder = InputBox("Enter the outputfolder name", "Folder name")
fpath = Left(fpath, Len(fpath) - 1)
cutnum = InStrRev(fpath, "\")
fpath = Left(fpath, cutnum)
'will open all the files in Column B and save as xl files
For i = 1 To n
Workbooks.Open Filename:=HtmlFpath & Sheet1.Cells(i, 1)
ActiveWorkbook.SaveAs Filename:=fpath & outputfolder & "\" & Sheet1.Cells(i, 2), FileFormat:=xlWorkbookNormal
ActiveWorkbook.Close
Next i
Application.ScreenUpdating = True
MsgBox "Done"
Exit Sub
errorhandler:
msg = "Error # " & Str(Err.Number) & " was generated by " _
& Err.Source & Chr(13) & Err.Description & vbCrLf & vbCrLf & "Ending program now"
MsgBox msg, , "Error", Err.HelpFile, Err.HelpContext
Application.ScreenUpdating = True
End Sub
Wednesday, March 09, 2005
String Operations
I found this on microsoft's website. I didn't know that I can use MID function on the LHS and converting string to ASCII will speed up the process. Cool!!
"The following points provide suggestions for ways to enhance the performance of string operations:
Minimize concatenation operations when you can. You can use the Mid function on the left side of the equal sign to replace characters within the string, rather than concatenating them together. The drawback to using the Mid function is that the replacement string must be the same length as the substring you are replacing.
Dim strText As String
strText = 'this is a test'
Mid(strText, 11, 4) = 'tent'
Debug.Print strText
Microsoft Visual Basic for Applications (VBA) provides a number of intrinsic string constants that you can use to replace function calls. For example, you can use the vbCrLf constant to represent a carriage return/linefeed combination within a string, rather than using Chr(13) & Chr(10).
String-comparison operations are slow. Sometimes, you can avoid them by converting a character in the string to an ANSI value. For example, the following code checks whether the first character in a string is a space:
The previous code is faster than the following:
"The following points provide suggestions for ways to enhance the performance of string operations:
Minimize concatenation operations when you can. You can use the Mid function on the left side of the equal sign to replace characters within the string, rather than concatenating them together. The drawback to using the Mid function is that the replacement string must be the same length as the substring you are replacing.
Dim strText As String
strText = 'this is a test'
Mid(strText, 11, 4) = 'tent'
Debug.Print strText
Microsoft Visual Basic for Applications (VBA) provides a number of intrinsic string constants that you can use to replace function calls. For example, you can use the vbCrLf constant to represent a carriage return/linefeed combination within a string, rather than using Chr(13) & Chr(10).
String-comparison operations are slow. Sometimes, you can avoid them by converting a character in the string to an ANSI value. For example, the following code checks whether the first character in a string is a space:
If Asc(strText) = 32 Then
The previous code is faster than the following:
If Left(strText, 1) = ' ' Then"
Labels: String Operations
# posted by Ashutosh : 11:48 AM
0 comments
links to this post
String Operations" title="Bookmark using any bookmark manager!" target="_blank">
Sunday, March 06, 2005
PMT Worksheet Function
PMT function has various uses; if you go to Excel help you’ll see its uses. I am using it to calculate monthly payment I have to do pay off credit card debt. If you also want to do that please follow these steps:
1. Type this A1=Card Name, B1=Balance, C1=Years, D1= Interest rate, E1=Monthly Payment, F1=Total payment, G1=Interest paid.
2. In the Card Name field you should enter the Card’s name you want to calculate monthly payments for, Balance is enter your credit card balance, Years you want to pay your debt off, current interest rate of your credit card. Monthly payment, total payment, and interest paid would be calculated using our formulas. Also, change the format of the interest rate field to percentage by Right click>Format Cells>Number>Percentage
3. In cell E2 enter this formula
=IF(ISERROR(PMT(D2/12,C2*12,B2)),0,PMT(D2/12,C2*12,B2))
Explanation:
PMT(D2/12,C2*12,B2)
D2, interest rate, is divided by 12 to get monthly interest rate
C2, number of years, is multiplied by 12 to get number of months
B2, balance on your credit card
Now, PMT function will calculate exact monthly payments you’d need to pay off your debt.
ISERROR(….)
Explanation:
ISERROR function will check if the expression given produces an error and it will return TRUE or FALSE.
Finally, an IF is used to put a zero as result of the formula if it produces any error.
4. In cell F2 enter this formula
=E2*C2*12
This will give us the total payment done over the years.
5. In cell G2 enter this formula
=F2+B2
This will give us the total interest paid to pay off the debt.
This sheet should look like this
Note: the result of our formulas will generate red numbers in brackets; this is the way of Excel to show us negative numbers. If you have Office XP or 2003 you can view a training session here.
1. Type this A1=Card Name, B1=Balance, C1=Years, D1= Interest rate, E1=Monthly Payment, F1=Total payment, G1=Interest paid.
2. In the Card Name field you should enter the Card’s name you want to calculate monthly payments for, Balance is enter your credit card balance, Years you want to pay your debt off, current interest rate of your credit card. Monthly payment, total payment, and interest paid would be calculated using our formulas. Also, change the format of the interest rate field to percentage by Right click>Format Cells>Number>Percentage
3. In cell E2 enter this formula
=IF(ISERROR(PMT(D2/12,C2*12,B2)),0,PMT(D2/12,C2*12,B2))
Explanation:
PMT(D2/12,C2*12,B2)
D2, interest rate, is divided by 12 to get monthly interest rate
C2, number of years, is multiplied by 12 to get number of months
B2, balance on your credit card
Now, PMT function will calculate exact monthly payments you’d need to pay off your debt.
ISERROR(….)
Explanation:
ISERROR function will check if the expression given produces an error and it will return TRUE or FALSE.
Finally, an IF is used to put a zero as result of the formula if it produces any error.
4. In cell F2 enter this formula
=E2*C2*12
This will give us the total payment done over the years.
5. In cell G2 enter this formula
=F2+B2
This will give us the total interest paid to pay off the debt.
This sheet should look like this
Note: the result of our formulas will generate red numbers in brackets; this is the way of Excel to show us negative numbers. If you have Office XP or 2003 you can view a training session here.
Thursday, March 03, 2005
To check if a workbook is open, if it's not open it
This Procedure will ask for a file name to the user, will check if the file is open and if it's not open it will open the file otherwise give a message to the user.
Public Sub IsWorkbookOpen()
Dim Wb As Workbook, wkbk As Variant
'get the dialog box to open the file
wkbk = Application.GetOpenFilename("Excel Files,*.xls")
If wkbk = False Then Exit Sub
'check if its already opened in the Windows collection
Dim flag As Boolean
flag = False
For Each Wb In Workbooks
If Wb.Path & "\" & Wb.Name = wkbk Then
MsgBox "File is already open", vbExclamation, "Workbook Open"
Wb.Activate
flag = True
End If
Next Wb
If flag = False Then Workbooks.Open (wkbk)
End Sub
Dim Wb As Workbook, wkbk As Variant
'get the dialog box to open the file
wkbk = Application.GetOpenFilename("Excel Files,*.xls")
If wkbk = False Then Exit Sub
'check if its already opened in the Windows collection
Dim flag As Boolean
flag = False
For Each Wb In Workbooks
If Wb.Path & "\" & Wb.Name = wkbk Then
MsgBox "File is already open", vbExclamation, "Workbook Open"
Wb.Activate
flag = True
End If
Next Wb
If flag = False Then Workbooks.Open (wkbk)
End Sub
Tuesday, March 01, 2005
Super-Easy Guide to the Microsoft Office Excel 2003 Object Model
One more tutorial for VBA beginners. It's really great, you'd be amazed by the power of VBA and it is very easy to learn. So why wait? start programming right now
Super-Easy Guide to the Microsoft Office Excel 2003 Object Model
Summary: Learn how easy it is to use the Excel object model to customize the way you work with Excel. Lessons include creating subroutines, the basics of objects, methods, and properties, and using dialog boxes. (29 printed pages)
Super-Easy Guide to the Microsoft Office Excel 2003 Object Model
Summary: Learn how easy it is to use the Excel object model to customize the way you work with Excel. Lessons include creating subroutines, the basics of objects, methods, and properties, and using dialog boxes. (29 printed pages)
VBA Samples for Working with Excel 2003 Worksheets
