PDA

View Full Version : Improving VBA code



thomashp79
03-25-2015, 01:39 PM
Hi all :)

This is my first post so hope I don't ask in the wrong section.

I am trying to shorten the following code down so that I don't have to write the same line over and over but instead use arrays or something equivalent.

(This is only part of my code and different sections of it)

Dim FilePath1 As String
Dim FilePath2 As String
Dim FilePath3 As String
------------------------------------------------------------------------------------
Open FilePath1 For Input As #1
Open FilePath2 For Input As #2
Open FilePath3 For Input As #3
---------------------------------------------------------------------------------------
Do Until EOF(1)
Line Input #1, strFirstLine1
Loop

Do Until EOF(2)
Line Input #2, strFirstLine2
Loop

Do Until EOF(3)
Line Input #3, strFirstLine3
Loop
------------------------------------------------------------------------------
If IsNumeric(strFirstLine1) Then
Sheet1.Range("D2") = (strFirstLine1)
End If
Close #1
If IsNumeric(strFirstLine2) Then
Sheet1.Range("B2") = (strFirstLine2)
End If
Close #2
If IsNumeric(strFirstLine3) Then
Sheet1.Range("D3") = (strFirstLine3)
End If
Close #3
------------------------------------------------------------------------------
If Sheet1.Range("A13") < Sheet1.Range("B13") Then
Sheet1.Range("C13") = "TRUE"
Else
Sheet1.Range("C13") = "FALSE"
End If

If Sheet1.Range("A14") < Sheet1.Range("B14") Then
Sheet1.Range("C14") = "TRUE"
Else
Sheet1.Range("C14") = "FALSE"
End If

If Sheet1.Range("A15") < Sheet1.Range("B15") Then
Sheet1.Range("C15") = "TRUE"
Else
Sheet1.Range("C15") = "FALSE"
End If

MINCUS1308
03-27-2015, 05:28 AM
Welcome to the form :)
Congrats on your first post.
~~ you might consider using the code tags when posting large hunks of code ;)
just click the little hash tag symbol on the quick reply ribbon and insert your code.

if you plan on using this code in a bunch of different places you could make it a separate sub or a function.
that way you would just write it once and just Call the sub/function as necessary.

Just pass the sub/function any variables that it requires.

but then, there is also the copy and paste method - it really saves on the typing.

thomashp79
03-27-2015, 07:25 AM
Thanks :) I am not sure if it would work though. For example on this code that I pasted below. How would I make that a separate sub or function ? It is not the same fields that it need to check. I have already tried the copy/paste method but that is tiresome as often I have to change something in the code and then I need to change the same thing many times in the code.

If IsNumeric(strFirstLine1) Then
Sheet1.Range("D2") = (strFirstLine1)
End If
Close #1
If IsNumeric(strFirstLine2) Then
Sheet1.Range("B2") = (strFirstLine2)
End If
Close #2
If IsNumeric(strFirstLine3) Then
Sheet1.Range("D3") = (strFirstLine3)
End If
Close #3

thomashp79
03-27-2015, 07:29 AM
My hope was, that I could change this code:
If IsNumeric(strFirstLine1) Then
Sheet1.Range("A1") = (strFirstLine1)
End If
Close #1
If IsNumeric(strFirstLine2) Then
Sheet1.Range("B1") = (strFirstLine2)
End If
Close #2
If IsNumeric(strFirstLine3) Then
Sheet1.Range("C1") = (strFirstLine3)
End If
Close #3

To something like this:
If IsNumeric(strFirstLine1:3) Then
Sheet1.Range("A1:C1") = (strFirstLine1:3)
End If
Close #1:3

Is that not possible ?

Bruce2g
03-28-2015, 11:48 PM
Hi,

I've seen and use a code from other powerpoint and wanted to make it work for slide text to change color. What command will be added to the code below

' Load Colour Scheme 14: Heart
Sub Header_Color14()
' Upper Title Bar: Slide Master
With ActivePresentation.SlideMaster.Shapes("Rectangle 2")
.Fill.ForeColor.RGB = RGB(128, 0, 0)
End With

' Lower Title Bar: Slide Master
With ActivePresentation.SlideMaster.Shapes.Range(Array("Text Box 12", "Group 159", "Text Box 94", "Rectangle 98"))
.Fill.ForeColor.RGB = RGB(0, 0, 128)
End With

' Upper Title Bar: Title Master
With ActivePresentation.TitleMaster.Shapes("Rectangle 101")
.Fill.ForeColor.RGB = RGB(128, 0, 0)
End With

' Lower Title Bar: Title Master
With ActivePresentation.TitleMaster.Shapes("Rectangle 324")
.Fill.ForeColor.RGB = RGB(0, 0, 128)
End With
End Sub

MINCUS1308
03-30-2015, 05:12 AM
Bruce2g, I think you stumbled onto the wrong page. Try posting your question as a separate thread.

thomashp79, there are two ways that i am aware of.

1) write a separate sub/function and pass it the names of the variables/fields.
2) a Loop that steps through each of the variables/fields one at a time.

you might try a loop similar to the following:


Sub test()

For i = 1 To 9

sMyString = Sheet1.Cells(1, i).Value

If IsNumeric(sMyString) Then
Sheet1.Cells(2, i) = sMyString
Else
MsgBox sMyString & " Is Not Numeric."
Sheet1.Cells(2, i).Value = ""
End If

Next i
End Sub

This sub steps across row 1 (for 9 cells) and checks if the value is numeric.
if so, it places the value in the cell beneath it.
if not, it outputs a msgbox and leaves the cell beneath it blank.

thomashp79
04-01-2015, 05:58 AM
MINCUS1308, that seems like it would work. Will let you know after I have tested it out :) Thanks a lot for the help and happy Easter :)