Posts by Craig Ottley

Craig Ottley · Mar 29th 2007

Re: Macro To Generate Message Box Based On Colour Of Cells On A Sheet

have you got a sample worksheet to go off?

Craig Ottley · Mar 29th 2007

Re: List Files In A Folder In A Worksheet

very cleaver :o)

Craig Ottley · Mar 29th 2007

Re: Vbnullstring: Runtime Error -2147417848

untested

Code

Dim max_reihen,  lowestRow, latestCol As long
Dim wksA As Worksheet 
 


 '[...]
Set wksA =ActiveSheet 
With wksA 
    .Range("A1").activate 'sets focus from possibly selected chart back to sheet
    max_reihen=526 'state of variable just before the critical line is met
    lowestRow=2000 'state of variable just before the critical line is met
    latestCol=26 'state of variable just before the critical line is met
    .Range(.Cells(max_reihen, 1), .Cells(lowestRow, latestCol)) = Empty '<--CRITICAL LINE causing runtime error -2147417848
     '[...]
    '.Range(.Cells(max_reihen, 1), .Cells(lowestRow, latestCol)).ClearContents '<-- this was my alternative, but this causes a "Runtime error 1004" instead
     '[...]
End With

Display More

Craig Ottley · Mar 29th 2007

Re: Locking Cell If Value

try something along the lines of this

Code

Private Sub Worksheet_Change(ByVal Target As Range)


    
    Dim iRangeSource, iRangeChange As Range
    Dim ws As Worksheet
    Dim pass As String
    
        pass = "PASSWORD"
        
            Set ws = ActiveSheet
            Set iRangeSource = Range("K4")
            Set iRangeChange = Range("F6")
            
            Select Case UCase(iRangeSource)
                
                Case "DAILY"
                    ws.Unprotect '(pass)
                        iRangeChange.Locked = False
                    ws.Protect '(pass)
                    
                Case "MONTHLY"
                    ws.Unprotect '(pass)
                        iRangeSource.Locked = False
                        iRangeChange.Locked = True
                    ws.Protect '(pass)
                 
            End Select
            
            Set ws = Nothing
            Set iRangeSource = Nothing
            Set iRangeChange = Nothing


End Sub

Display More

Craig Ottley · Mar 29th 2007

Re: No Range.select Within Beforeprint

i'm not sure if this will help you?

Code

Dim myArray As Variant


myArray = Application.Union(Range("d6"), Range("d7"))
   
  For i = 1 To UBound(myArray)
  
    If myArray(i, 1) = "" Then
    
           
    End If
    
  Next i

Display More

Craig Ottley · Mar 29th 2007

Re: Import Calendar Days To Specific Cells

Further to Will's post you'll need to add a reference library in vba

Microsoft Outlook 1x.xx Object Library

Craig Ottley · Mar 29th 2007

Re: Change Access Default Warning Message

you can do this on the property before update...

Please note you'll need the Reference Microsoft DAO 3.xx Object Library

Code

Private Sub textboxCombobox_BeforeUpdate(Cancel As Integer)


Dim SID As String
Dim stLinkCriteria As String
Dim Rst As DAO.Recordset


Set Rst = Me.RecordsetClone


SID = Me.textboxCombobox.Value


stLinkCriteria = "[field]=" & "'" & SID & "'"


    'Check table for duplicates
        If DCount("textboxCombobox", "tblname", stLinkCriteria) > 0 Then
        'Undo duplicate entry
        Me.Undo
        
        'Message box warning of duplication
        MsgBox "Warning Number " _
        & SID & " has already been entered." _
        & vbCr & vbCr & "You will now been taken to the record.", vbInformation _
        , "Duplicate Information"
        'Go to original record
        Rst.FindFirst stLinkCriteria
        
        Me.Bookmark = Rst.Bookmark
        
    End If


Set Rst = Nothing


End Sub


End Sub

Display More

Craig Ottley · Mar 28th 2007

Re: Changing Borders In A Document With Vba

something like this should help you

Code

Sub formatCurrentRegion()


    Selection.CurrentRegion.Select


    With Selection
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThin
        .Borders(xlEdgeTop).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlEdgeRight).ColorIndex = xlAutomatic
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideVertical).ColorIndex = xlAutomatic
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).Weight = xlThin
        .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic
    End With
    
End Sub

Display More

Craig Ottley · Mar 28th 2007

Re: Colour Change Autoshape

Code

Private Sub CommandButton1_Click() 
    Dim X As Integer 
    X = Range("H5").Value 
    With Sheets("Sheet 1").Shapes("Rectangle 1").Select 
        Select Case X 
             
Case Is > 0: 
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255,0,0)
             
Case Is < 0: 
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(0,255,0) 
             
Case Else: 
            Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255,255,255) 
        End Select 
         
    End With 
     
    UserForm2.Hide 
     
End Sub

Display More

Craig Ottley · Mar 28th 2007

Re: Colour Change Autoshape

have you got a sample sheet?

Craig Ottley · Mar 28th 2007

Re: Talking To An Equipment Through Serial Port

i'd check out this website you need references:

Craig Ottley · Mar 28th 2007

Re: Update Date On A Hidden Worksheet With Macro

yeah something like this for a named sheets will work fine...

Code

Sub unhide()


Dim ws As Worksheet


Set ws = Sheets("Sheet1")


    ws.Visible = xlSheetVisible


'put your code here


   ws.visible = xlSheetHidden ' or xlSheetVeryHidden


set ws = nothing


End Sub

Display More

Craig Ottley · Mar 27th 2007

Re: Vba Code For Switching From Sheet To Sheet

something onlong the lines of this

Code

Sub LoopSheets()


For Each ws In ActiveWorkbook.Worksheets
    
    ws.Activate
    Call yourMacroFunctionNameHere
    
Next ws


End Sub

Display More

Craig Ottley · Mar 27th 2007

Re: Automatic Index For Jpg Folder

try putting this in your code

Code

On Error Resume Next


        Set fl = fs.GetFileName(f) ' <= this is where it gets stuck.

Craig Ottley · Mar 27th 2007

Re: Listing All Part Number Combinations

Got ya...

Craig Ottley · Mar 27th 2007

Re: Listing All Part Number Combinations

i've inserted a concatemate formula into the spreadsheet to see if thats what you want to happen?

Craig Ottley · Mar 27th 2007

Re: Listing All Part Number Combinations

do you mean something of a permutation?

what i mean is. If the cell to the right has a value in it then take the left cells value and then concatenate(Join together) the two cells. Then if the cell to the right and one below has a value... take the same first cell and concatenate it with the cell right and below... ?

Craig Ottley · Mar 27th 2007

Re: Picture In A Picture

if the pictures already in the workbook you can control it with shapes, making a certain picture visible if the cell in sheet1 is red...

Craig Ottley · Mar 27th 2007

Re: For Each Worksheet

are you just converting any formula into values for column G?

Craig Ottley · Mar 27th 2007

Re: Opening Another Workbook

you need to add the directory in

Code

Const MyDirLoad As String = "C:\blah\blah\blah\"


Public Function OpenWorkBook()
    
    'Optional
    'Application.ScreenUpdating = False


    Dim myWB As Workbook
     'this opens the file and sets an object variable to the opened file
    Set myWB = Workbooks.Open(MyDirLoad & "Whatever" & ".xls")
     'this runs the Auto_Open macro if there is one.
    'Note that the above object variable is used in this statement
    myWB.RunAutoMacros xlAutoOpen


   
        
    'Application.ScreenUpdating = True
    
End Function

Display More