Posts by Craig Ottley

Craig Ottley · Mar 27th 2007

Re: For Each Worksheet

yeah something like that would work fine

Code

sub sheets()


For Each Ws In ActiveWorkbook.Worksheets
    
      Call (Macro/Function Name Here)


    Next Ws


End Sub

Display More

Craig Ottley · Mar 27th 2007

Re: Selecting Next Usable Cell And Paste

Ahh i think i know why... lastR is set inside the loop... try putting set lastR inside the for loop:

Code

For Each e In myWS 
     
    Set lastR = sheets("E").Range("b" & Rows.Count).End(xlUp).Offset(1, 1) 
     
    lastR.Resize(, 2).Value = Range("c4:d4").Value 


    Set lastR = Nothing 


Next e

Display More

Craig Ottley · Mar 27th 2007

Re: Selecting Next Usable Cell And Paste

to go one column right the

Code

.
offset(1,0)

should be changed to

Code

.Offset(1, 1)

Craig Ottley · Mar 27th 2007

Re: Update Mastersheet From 5 Worksheets

a good VBA book to start with would be Sams Teach Yourself Visual Basic in 21 days... you can grab these on amazon for a good price...

as for your macro. could you explain as to what 'exactly' you want it to grab from your other sheets...

zimitry

Craig Ottley · Mar 27th 2007

Re: Add New Styled Rows

Here it goes...

Code

Function InRange(Range1 As Range, Range2 As Range) As Boolean
' returns True if Range1 is within Range2
Dim InterSectRange As Range
    Set InterSectRange = Application.Intersect(Range1, Range2)
    InRange = Not InterSectRange Is Nothing
    Set InterSectRange = Nothing
End Function




Sub Nieuwe_sporter()


    If InRange(ActiveCell, Range("A:A")) Then ' change range
        ' code to handle that the active cell is within the right range
      Application.Union(ActiveCell, ActiveCell.Offset(1, 0)).Select
    
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .MergeCells = True
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
     
    ActiveCell.Offset(0, 1).Select
    Application.Union(ActiveCell, ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 1) _
                        , ActiveCell.Offset(0, 1), ActiveCell.Offset(1, 2), ActiveCell.Offset(0, 2) _
                        , ActiveCell.Offset(1, 3), ActiveCell.Offset(0, 3), ActiveCell.Offset(1, 4) _
                        , ActiveCell.Offset(0, 4), ActiveCell.Offset(1, 5), ActiveCell.Offset(0, 5) _
                        , ActiveCell.Offset(1, 6), ActiveCell.Offset(0, 6), ActiveCell.Offset(1, 7) _
                        , ActiveCell.Offset(0, 7), ActiveCell.Offset(1, 8), ActiveCell.Offset(0, 8)).Select
    


    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).ColorIndex = xlAutomatic
        .Borders(xlEdgeLeft).TintAndShade = 0
        .Borders(xlEdgeLeft).Weight = xlThin
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeTop).ColorIndex = xlAutomatic
        .Borders(xlEdgeTop).TintAndShade = 0
        .Borders(xlEdgeTop).Weight = xlThick
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).ColorIndex = xlAutomatic
        .Borders(xlEdgeBottom).TintAndShade = 0
        .Borders(xlEdgeBottom).Weight = xlThin
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeRight).ColorIndex = xlAutomatic
        .Borders(xlEdgeRight).TintAndShade = 0
        .Borders(xlEdgeRight).Weight = xlThin
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideVertical).ColorIndex = xlAutomatic
        .Borders(xlInsideVertical).TintAndShade = 0
        .Borders(xlInsideVertical).Weight = xlThin
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).ColorIndex = xlAutomatic
        .Borders(xlInsideHorizontal).TintAndShade = 0
        .Borders(xlInsideHorizontal).Weight = xlThin
       End With
       
            Else
        ' code to handle that the active cell is not within the right range
        MsgBox "Active Cell NOT In Range!"
    End If
    
End Sub

Display More

Craig Ottley · Mar 27th 2007

Re: If Statement For Duplicate Entries

Have you tried using a pivot table? seems a better approach

Craig Ottley · Mar 27th 2007

Re: Correcting Output If No Value Found

The only difference that i noted was the Semicolon ; i just changed it for a comma ,...

that will return 0 even if there isn't any data in the other sheet... how ever if you wanted to return a blank i'd add an if statement in there something like this:=

=IF(SUMIF('616'!$B$1:$B$2000,'AP AMT DKK'!$B4,'616'!$D$1:$D$2000)=0,"",SUMIF('616'!$B$1:$B$2000,'AP AMT DKK'!$B4,'616'!$D$1:$D$2000))

Craig Ottley · Mar 27th 2007

Re: Correcting Output If No Value Found

are you linking a workbook or is it in the same one?

if it's in the same one try this:=

=SUMIF('616'!$B$1:$B$2000,'AP AMT DKK'!$B4,'616'!$D$1:$D$2000)

Craig Ottley · Mar 27th 2007

Re: Finding Max And Average

try this

Code

Sub maxTemperature()
   
    Dim ws As Worksheet
    Dim myRange As Range
     
        Set ws = Sheets("Sheet2")
        Set myRange = ws.Cells(1, 2).CurrentRegion
        cellCount@ = myRange.Count
        iMax = ActiveCell.Value
     
  
            i = 2
                While i <= cellCount@
                    If Cells(i, 2) > iMax Then iMax = Cells(i, 2).Value
                    i = i + 1
                Wend
                 Range("A25").Value = iMax
                    isum = 0
                    For i = 1 To cellCount@
                        isum = isum + Cells(i, 2)
                    Next i
                        ave = Format(isum / cellCount@, "#,##0.00")
                        Range("A26").Value = ave
             
        Set ws = Nothing
        Set myRange = Nothing
End Sub

Display More

Craig Ottley · Mar 27th 2007

Re: Selecting Next Usable Cell And Paste

try this

Code

For Each e In myWS
    
         Set lastR = ActiveSheet.Range("b" & Rows.Count).End(xlUp).Offset(1, 0)
     
        lastR.Resize(, 2).Value = Range("c4:d4").Value
     
    Next e


Set lastR = Nothing

Craig Ottley · Mar 26th 2007

Re: Housekeeping Macro

take out SearchFormat:= in xls 2000 it's an add-in in 2003

Code

Wks2.Range("C1:C500").Replace What:=strFind, Replacement:=""

Craig Ottley · Mar 26th 2007

Re: Input Dialogue Transfer To Msg Box

Pass for user options relating to security i'd use SQL or Access...

Craig Ottley · Mar 26th 2007

Re: Container Linking Data

try finding the function for this

Code

Public Sub ShowList()
    On Error GoTo ErrX
    Call [b]RShowUserLists[/b](, ThisWorkbook.Names("assetclass").RefersToRange.Value, False)
ErrX:
End Sub

right click on RShowUserLists and then select Definition this should take you to the code where your list is populated...

Craig Ottley · Mar 26th 2007

Re: Container Linking Data

Does your code look something like this?

Code

Private Sub MAIN_Chilled_Customer_TabStrip_Change()
Call Put_To_Main_List
End Sub


Function Put_To_Main_List()


If MAIN_Chilled_Customer_TabStrip.Value = 0 Then Create_List ("CHL Safeway")
If MAIN_Chilled_Customer_TabStrip.Value = 1 Then Create_List ("CHL Sainsburys")
If MAIN_Chilled_Customer_TabStrip.Value = 2 Then Create_List ("CHL Somerfield")
If MAIN_Chilled_Customer_TabStrip.Value = 3 Then Create_List ("CHL Morrisons")
If MAIN_Chilled_Customer_TabStrip.Value = 4 Then Create_List ("CHL Big Value")
If MAIN_Chilled_Customer_TabStrip.Value = 5 Then Create_List ("FRZ Asda")
MAIN_List.SetFocus
If MAIN_List.ListCount > 0 Then MAIN_List.ListIndex = 0


End Function




' Creates list depending on Customer
Function Create_List(Customer As String)
Dim Product_Num As Integer


MAIN_List.Clear


Product_Num = 0
While PRODUCTS(Product_Num, 0) <> ""
If PRODUCTS(Product_Num, 0) = Customer Then
MAIN_List.AddItem (Ret_Product_Code(Product_Num))
MAIN_List.List(MAIN_List.ListCount - 1, 1) = Ret_Description(Product_Num)
MAIN_List.List(MAIN_List.ListCount - 1, 2) = Product_Num
End If
Product_Num = Product_Num + 1
Wend
End Function

Display More

Craig Ottley · Mar 26th 2007

Re: Housekeeping Macro

lol, sometimes it's a complete nightmare! people don't know how to use access so when excel has to sort through 40,000 + records it takes a while to do its thing... all you get on the phone is "I think its broke!" not something you want to be hearing first thing on a Monday morning (Or Friday Afternoon)...

Craig Ottley · Mar 26th 2007

Re: Prompting User To Enter Information

There are two ways i can think of.

1) have a user form to input all variables into the sheet
2) have input boxes till all required fields have been entered...

EDIT:=

why not lock your cells and protect the workbook?

Craig Ottley · Mar 26th 2007

Re: Housekeeping Macro

Thanks Will, i'll keep that in mind... most of the work i do in work i have to write like that anyway because people will look at the screen and say its not working with big applications... thanks for the tip : D

Craig Ottley · Mar 26th 2007

Re: Housekeeping Macro

I've done mine a bit differently works fine though assuming there are no blank rows...

Code

Sub timBos()


Dim ws As Worksheet
Dim wsNext As String
Dim Response


Set ws = Sheets("sheet2")


With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    .EnableEvents = False
End With


    Response = CStr(Application.InputBox("Please Enter Numeric ID?", "Data To Find", Type:=1))


        ws.Activate
            Cells(1, 1).Select
 
            Do
       
                If Trim(ActiveCell.Value) = Response Then
    
                    ActiveCell.Offset(0, 13).Value = Date
    
                    ActiveCell.Offset(0, 16).Value = Response
                    'Clear the cells
                    ActiveCell.Offset(0, 17).ClearContents
                    ActiveCell.Offset(0, 18).ClearContents
                    ActiveCell.Offset(0, 20).ClearContents
                    ActiveCell.Offset(0, 21).ClearContents
                    ActiveCell.Offset(0, 23).ClearContents
                    ActiveCell.Offset(0, 24).ClearContents
                    ActiveCell.Offset(0, 26).ClearContents
                    ActiveCell.Offset(0, 27).ClearContents
                    ActiveCell.Offset(0, 29).ClearContents
                    ActiveCell.Offset(0, 30).ClearContents
                        'Next worksheet to find
                        wsNext = CStr(Trim(ActiveCell.Offset(0, 9).Value))
    
                ActiveCell.Offset(1, 0).Select
    
                Else
    
                    ActiveCell.Offset(1, 0).Select
    
                End If


            Loop Until Trim(ActiveCell.Value) = Empty ' or ""


       
               
                    If wsNext = Empty Then
                        MsgBox "No Worksheet Set In Data Values, Please check cell", vbExclamation
                        Exit Sub
                    Else
                        Set ws = Sheets(wsNext)
                        ws.Activate
                        Cells(1, 3).Activate
                    End If
                    
                        Do
                        
                            If Trim(ActiveCell.Value) = Response Then
                                ActiveCell.ClearContents
                                ActiveCell.Offset(1, 0).Select
                            Else
                                ActiveCell.Offset(1, 0).Select
                                                
                            End If
                            
                        Loop Until Trim(ActiveCell.Value) = Empty ' Or ""
Set ws = Nothing


With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
    .EnableEvents = True
End With

Display More

Craig Ottley · Mar 26th 2007

Re: Housekeeping Macro

----

Craig Ottley · Mar 26th 2007

Re: Housekeeping Macro

have you got a sample workbook to go off with your attempted code?